rose-ash/hosts/ocaml/browser/sx_browser.ml

(** sx_browser.ml — OCaml SX kernel compiled to WASM/JS for browser use.

    Exposes the CEK machine, bytecode VM, parser, and primitives as a
    global [SxKernel] object that the JS platform layer binds to.

    Fresh implementation on the ocaml-vm branch — builds on the bytecode
    VM + lazy JIT infrastructure. *)

open Js_of_ocaml
open Sx_types

(* ================================================================== *)
(* Opaque value handle table                                           *)
(*                                                                     *)
(* Non-primitive SX values (lambdas, components, signals, etc.) are    *)
(* stored here and represented on the JS side as objects with an       *)
(* __sx_handle integer key.  Preserves identity across JS↔OCaml.      *)
(* ================================================================== *)

let _next_handle = ref 0
let _handle_table : (int, value) Hashtbl.t = Hashtbl.create 256

let alloc_handle (v : value) : int =
  let id = !_next_handle in
  incr _next_handle;
  Hashtbl.replace _handle_table id v;
  id

let get_handle (id : int) : value =
  match Hashtbl.find_opt _handle_table id with
  | Some v -> v
  | None -> raise (Eval_error (Printf.sprintf "Invalid SX handle: %d" id))

(* JS-side opaque host object table.
   Host objects (DOM elements, console, etc.) are stored here to preserve
   identity across the OCaml↔JS boundary. Represented as Dict with
   __host_handle key on the OCaml side. *)
let _next_host_handle = ref 0
let _alloc_host_handle = Js.Unsafe.pure_js_expr
  "(function() { var t = {}; var n = 0; return { put: function(obj) { var id = n++; t[id] = obj; return id; }, get: function(id) { return t[id]; } }; })()"
let host_put (obj : Js.Unsafe.any) : int =
  let id = !_next_host_handle in
  incr _next_host_handle;
  ignore (Js.Unsafe.meth_call _alloc_host_handle "put" [| obj |]);
  id
let host_get_js (id : int) : Js.Unsafe.any =
  Js.Unsafe.meth_call _alloc_host_handle "get" [| Js.Unsafe.inject id |]

(* ================================================================== *)
(* Global environment                                                  *)
(* ================================================================== *)

(* Clear scope stacks at startup *)
let () = Sx_primitives.scope_clear_all ()

let global_env = make_env ()
let _sx_render_mode = ref false

let call_sx_fn (fn : value) (args : value list) : value =
  let result = Sx_runtime.sx_call fn args in
  !Sx_primitives._sx_trampoline_fn result

(* ================================================================== *)
(* Value conversion: OCaml <-> JS                                      *)
(* ================================================================== *)

(** Tag a JS function with __sx_handle and _type properties. *)
let _tag_fn = Js.Unsafe.pure_js_expr
  "(function(fn, handle, type) { fn.__sx_handle = handle; fn._type = type; return fn; })"

let rec value_to_js (v : value) : Js.Unsafe.any =
  match v with
  | Nil -> Js.Unsafe.inject Js.null
  | Bool b -> Js.Unsafe.inject (Js.bool b)
  | Number n -> Js.Unsafe.inject (Js.number_of_float n)
  | String s -> Js.Unsafe.inject (Js.string s)
  | RawHTML s -> Js.Unsafe.inject (Js.string s)
  | Symbol s ->
    Js.Unsafe.inject (Js.Unsafe.obj [|
      ("_type", Js.Unsafe.inject (Js.string "symbol"));
      ("name", Js.Unsafe.inject (Js.string s)) |])
  | Keyword k ->
    Js.Unsafe.inject (Js.Unsafe.obj [|
      ("_type", Js.Unsafe.inject (Js.string "keyword"));
      ("name", Js.Unsafe.inject (Js.string k)) |])
  | List items | ListRef { contents = items } ->
    let arr = items |> List.map value_to_js |> Array.of_list in
    Js.Unsafe.inject (Js.Unsafe.obj [|
      ("_type", Js.Unsafe.inject (Js.string "list"));
      ("items", Js.Unsafe.inject (Js.array arr)) |])
  | Dict d ->
    (* Check for __host_handle — return original JS object *)
    (match Hashtbl.find_opt d "__host_handle" with
     | Some (Number n) -> host_get_js (int_of_float n)
     | _ ->
       let obj = Js.Unsafe.obj [||] in
       Js.Unsafe.set obj (Js.string "_type") (Js.string "dict");
       Hashtbl.iter (fun k v ->
         Js.Unsafe.set obj (Js.string k) (value_to_js v)) d;
       Js.Unsafe.inject obj)
  (* Callable values: wrap as JS functions with __sx_handle *)
  | Lambda _ | NativeFn _ | Continuation _ | CallccContinuation _ | VmClosure _ ->
    let handle = alloc_handle v in
    let inner = Js.wrap_callback (fun args_js ->
      try
        let arg = js_to_value args_js in
        let args = match arg with Nil -> [] | _ -> [arg] in
        let result = call_sx_fn v args in
        value_to_js result
      with
      | Eval_error msg ->
        let fn_info = Printf.sprintf " [callback %s handle=%d]" (type_of v) handle in
        ignore (Js.Unsafe.meth_call
          (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
          "error" [| Js.Unsafe.inject (Js.string ("[sx] " ^ msg ^ fn_info)) |]);
        Js.Unsafe.inject Js.null
      | exn ->
        let fn_info = Printf.sprintf " [callback %s handle=%d]" (type_of v) handle in
        ignore (Js.Unsafe.meth_call
          (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
          "error" [| Js.Unsafe.inject (Js.string ("[sx] UNCAUGHT: " ^ Printexc.to_string exn ^ fn_info)) |]);
        Js.Unsafe.inject Js.null) in
    Js.Unsafe.fun_call _tag_fn [|
      Js.Unsafe.inject inner;
      Js.Unsafe.inject handle;
      Js.Unsafe.inject (Js.string (type_of v)) |]
  (* Non-callable compound: tagged object with handle *)
  | _ ->
    let handle = alloc_handle v in
    Js.Unsafe.inject (Js.Unsafe.obj [|
      ("_type", Js.Unsafe.inject (Js.string (type_of v)));
      ("__sx_handle", Js.Unsafe.inject handle) |])

and js_to_value (js : Js.Unsafe.any) : value =
  if Js.Unsafe.equals js Js.null || Js.Unsafe.equals js Js.undefined then Nil
  else
    let ty = Js.to_string (Js.typeof js) in
    match ty with
    | "number" -> Number (Js.float_of_number (Js.Unsafe.coerce js))
    | "boolean" -> Bool (Js.to_bool (Js.Unsafe.coerce js))
    | "string" -> String (Js.to_string (Js.Unsafe.coerce js))
    | "function" ->
      let h = Js.Unsafe.get js (Js.string "__sx_handle") in
      if not (Js.Unsafe.equals h Js.undefined) then
        get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
      else
        (* Plain JS function — wrap as NativeFn *)
        NativeFn ("js-callback", fun args ->
          let js_args = args |> List.map value_to_js |> Array.of_list in
          js_to_value (Js.Unsafe.fun_call js (Array.map Fun.id js_args)))
    | "object" ->
      let h = Js.Unsafe.get js (Js.string "__sx_handle") in
      if not (Js.Unsafe.equals h Js.undefined) then
        get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float)
      else
        let type_field = Js.Unsafe.get js (Js.string "_type") in
        if Js.Unsafe.equals type_field Js.undefined then begin
          if Js.to_bool (Js.Unsafe.global##._Array##isArray js) then begin
            let n = Js.float_of_number (Js.Unsafe.coerce (Js.Unsafe.get js (Js.string "length"))) |> int_of_float in
            List (List.init n (fun i ->
              js_to_value (Js.array_get (Js.Unsafe.coerce js) i |> Js.Optdef.to_option |> Option.get)))
          end else begin
            (* Opaque host object — store in JS-side table, return Dict with __host_handle *)
            let id = host_put js in
            let d = Hashtbl.create 2 in
            Hashtbl.replace d "__host_handle" (Number (float_of_int id));
            Dict d
          end
        end else begin
          let tag = Js.to_string (Js.Unsafe.coerce type_field) in
          match tag with
          | "symbol" -> Symbol (Js.to_string (Js.Unsafe.get js (Js.string "name")))
          | "keyword" -> Keyword (Js.to_string (Js.Unsafe.get js (Js.string "name")))
          | "list" ->
            let items_js = Js.Unsafe.get js (Js.string "items") in
            let n = Js.float_of_number (Js.Unsafe.coerce (Js.Unsafe.get items_js (Js.string "length"))) |> int_of_float in
            List (List.init n (fun i ->
              js_to_value (Js.array_get (Js.Unsafe.coerce items_js) i |> Js.Optdef.to_option |> Option.get)))
          | "dict" ->
            let d = Hashtbl.create 8 in
            let keys = Js.Unsafe.global##._Object##keys js in
            let len = keys##.length in
            for i = 0 to len - 1 do
              let k = Js.to_string (Js.array_get keys i |> Js.Optdef.to_option |> Option.get) in
              if k <> "_type" then
                Hashtbl.replace d k (js_to_value (Js.Unsafe.get js (Js.string k)))
            done;
            Dict d
          | _ -> Nil
        end
    | _ -> Nil

(* ================================================================== *)
(* Side-channel return (bypasses js_of_ocaml stripping properties)     *)
(* ================================================================== *)

let return_via_side_channel (v : Js.Unsafe.any) : Js.Unsafe.any =
  Js.Unsafe.set Js.Unsafe.global (Js.string "__sxR") v; v

(* ================================================================== *)
(* Persistent VM globals — synced with global_env                      *)
(* ================================================================== *)

(* String-keyed mirror of global_env.bindings for VmClosures.
   VmClosures from bytecode modules hold vm_env_ref pointing here.
   Must stay in sync so VmClosures see post-boot definitions. *)
let _vm_globals : (string, value) Hashtbl.t = Hashtbl.create 512
let _in_batch = ref false

(* Sync env→VM: copy all bindings from global_env.bindings to _vm_globals.
   Called after CEK eval/load so VmClosures can see new definitions. *)
let sync_env_to_vm () =
  Hashtbl.iter (fun id v ->
    Hashtbl.replace _vm_globals (unintern id) v
  ) global_env.bindings

(* Hook: intercept env_bind on global_env to also update _vm_globals.
   Only sync bindings on the global env — let bindings in child envs
   must NOT leak into _vm_globals (they'd overwrite real definitions). *)
let () =
  Sx_types._env_bind_hook := Some (fun env name v ->
    if env == global_env then
      Hashtbl.replace _vm_globals name v)

(* Reverse hook: sync VM GLOBAL_SET mutations back to global_env.
   Without this, set! inside JIT-compiled functions writes to _vm_globals
   but leaves global_env stale — CEK reads then see the old value. *)
let () =
  Sx_types._vm_global_set_hook := Some (fun name v ->
    Hashtbl.replace global_env.bindings (Sx_types.intern name) v)

(* Symbol resolve hook: transparent lazy module loading.
   When GLOBAL_GET can't find a symbol, this calls the JS __resolve-symbol
   native which checks the manifest's symbol→library index and loads the
   library that exports it.  After loading, the symbol is in _vm_globals. *)
let () =
  Sx_types._symbol_resolve_hook := Some (fun name ->
    match Hashtbl.find_opt Sx_primitives.primitives "__resolve-symbol" with
    | None -> None
    | Some resolve_fn ->
      (try ignore (resolve_fn [String name]) with _ -> ());
      (* Check if the symbol appeared in globals after the load *)
      match Hashtbl.find_opt _vm_globals name with
      | Some v -> Some v
      | None -> None)

(* ================================================================== *)
(* Core API                                                            *)
(* ================================================================== *)

let api_parse src_js =
  let src = Js.to_string src_js in
  try
    let values = Sx_parser.parse_all src in
    Js.Unsafe.inject (Js.array (values |> List.map value_to_js |> Array.of_list))
  with Parse_error msg ->
    Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))

(** Build a JS suspension marker for the platform to handle.
    Returns {suspended: true, op: string, request: obj, resume: fn(result)} *)
let _make_js_suspension request resume_fn =
  let obj = Js.Unsafe.obj [||] in
  Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject (Js.bool true));
  let op = match request with
    | Dict d -> (match Hashtbl.find_opt d "op" with Some (String s) -> s | _ -> "unknown")
    | _ -> "unknown" in
  Js.Unsafe.set obj (Js.string "op") (Js.Unsafe.inject (Js.string op));
  Js.Unsafe.set obj (Js.string "request") (value_to_js request);
  Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun result_js ->
    let result = js_to_value result_js in
    resume_fn result));
  obj

(** Handle an import suspension: load the library from the library registry
    or return a suspension marker to JS for async loading. *)
let handle_import_suspension request =
  let lib_spec = match request with
    | Dict d -> (match Hashtbl.find_opt d "library" with Some v -> v | _ -> Nil)
    | _ -> Nil in
  let key = Sx_ref.library_name_key lib_spec in
  if Sx_types.sx_truthy (Sx_ref.library_loaded_p key) then
    Some Nil  (* Already loaded — resume immediately *)
  else
    None  (* Not loaded — JS platform must fetch it *)

let api_eval src_js =
  let src = Js.to_string src_js in
  try
    let exprs = Sx_parser.parse_all src in
    let env = Env global_env in
    let result = List.fold_left (fun _acc expr -> Sx_ref.eval_expr expr env) Nil exprs in
    sync_env_to_vm ();
    return_via_side_channel (value_to_js result)
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))

(** evalVM: compile SX source to bytecode and run through the VM.
    Globals defined with `define` are visible to subsequent evalVM/eval calls.
    This tests the exact same code path as island hydration and click handlers. *)
let api_eval_vm src_js =
  let src = Js.to_string src_js in
  try
    let exprs = Sx_parser.parse_all src in
    let compile_fn = match Hashtbl.find_opt _vm_globals "compile-module" with
      | Some v -> v
      | None -> env_get global_env "compile-module" in
    let code_val = Sx_ref.trampoline (Sx_runtime.sx_call compile_fn [List exprs]) in
    let code = Sx_vm.code_from_value code_val in
    let result = Sx_vm_ref.execute_module code _vm_globals in
    (* Sync VM globals → CEK env so subsequent eval() calls see defines *)
    Hashtbl.iter (fun name v ->
      let id = intern name in
      if not (Hashtbl.mem global_env.bindings id) then
        Hashtbl.replace global_env.bindings id v
      else (match Hashtbl.find global_env.bindings id, v with
        | VmClosure _, VmClosure _ | _, VmClosure _ -> Hashtbl.replace global_env.bindings id v
        | _ -> ())
    ) _vm_globals;
    return_via_side_channel (value_to_js result)
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))
  | Not_found -> Js.Unsafe.inject (Js.string "Error: compile-module not loaded")

let api_eval_expr expr_js _env_js =
  let expr = js_to_value expr_js in
  try
    let result = Sx_ref.eval_expr expr (Env global_env) in
    sync_env_to_vm ();
    return_via_side_channel (value_to_js result)
  with Eval_error msg ->
    Js.Unsafe.inject (Js.string ("Error: " ^ msg))

let api_load src_js =
  let src = Js.to_string src_js in
  try
    let exprs = Sx_parser.parse_all src in
    let env = Env global_env in
    let count = ref 0 in
    List.iter (fun expr ->
      (* Use IO-aware eval for each expression to handle import suspensions *)
      let state = Sx_ref.make_cek_state expr env (List []) in
      let final = ref (Sx_ref.cek_step_loop state) in
      while Sx_types.sx_truthy (Sx_ref.cek_suspended_p !final) do
        let request = Sx_ref.cek_io_request !final in
        let op = match request with
          | Dict d -> (match Hashtbl.find_opt d "op" with Some (String s) -> s | _ -> "")
          | _ -> "" in
        let response = if op = "import" then begin
          match handle_import_suspension request with
          | Some v -> v
          | None -> Nil  (* Library not found — resume with nil, import will use what's in env *)
        end else Nil in
        final := Sx_ref.cek_resume !final response
      done;
      ignore (Sx_ref.cek_value !final);
      incr count
    ) exprs;
    sync_env_to_vm ();
    Js.Unsafe.inject !count
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))

let api_begin_module_load () =
  (* Snapshot current env into the persistent VM globals table *)
  Hashtbl.clear _vm_globals;
  Hashtbl.iter (fun id v -> Hashtbl.replace _vm_globals (unintern id) v) global_env.bindings;
  _in_batch := true;
  Js.Unsafe.inject true

let api_end_module_load () =
  if !_in_batch then begin
    (* Copy VM globals back to env (bytecode modules defined new symbols) *)
    Hashtbl.iter (fun k v ->
      Hashtbl.replace global_env.bindings (intern k) v
    ) _vm_globals;
    _in_batch := false
  end;
  Js.Unsafe.inject true

let sync_vm_to_env () =
  Hashtbl.iter (fun name v ->
    let id = intern name in
    if not (Hashtbl.mem global_env.bindings id) then
      Hashtbl.replace global_env.bindings id v
    else begin
      (* Update existing binding if the VM has a newer value *)
      let existing = Hashtbl.find global_env.bindings id in
      match existing, v with
      | VmClosure _, VmClosure _ -> Hashtbl.replace global_env.bindings id v
      | _, VmClosure _ -> Hashtbl.replace global_env.bindings id v
      | _ -> ()
    end
  ) _vm_globals

(** Convert a VM suspension dict to a JS suspension object for the platform. *)
let rec make_js_import_suspension (d : (string, value) Hashtbl.t) =
  let obj = Js.Unsafe.obj [||] in
  Js.Unsafe.set obj (Js.string "suspended") (Js.Unsafe.inject Js._true);
  Js.Unsafe.set obj (Js.string "op") (Js.Unsafe.inject (Js.string "import"));
  let request = match Hashtbl.find_opt d "request" with Some v -> v | None -> Nil in
  Js.Unsafe.set obj (Js.string "request") (value_to_js request);
  (* resume callback: clears __io_request, pushes nil, re-runs VM *)
  Js.Unsafe.set obj (Js.string "resume") (Js.wrap_callback (fun _result_js ->
    let resumed = Sx_vm_ref.resume_module (Dict d) in
    sync_vm_to_env ();
    match resumed with
    | Dict d2 when (match Hashtbl.find_opt d2 "suspended" with Some (Bool true) -> true | _ -> false) ->
      Js.Unsafe.inject (make_js_import_suspension d2)
    | result -> value_to_js result));
  obj

let api_load_module module_js =
  try
    let code_val = js_to_value module_js in
    let code = Sx_vm.code_from_value code_val in
    let result = Sx_vm_ref.execute_module code _vm_globals in
    match result with
    | Dict d when (match Hashtbl.find_opt d "suspended" with Some (Bool true) -> true | _ -> false) ->
      (* VM suspended on OP_PERFORM (import) — return JS suspension object *)
      Js.Unsafe.inject (make_js_import_suspension d)
    | _ ->
      sync_vm_to_env ();
      Js.Unsafe.inject (Hashtbl.length _vm_globals)
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | exn -> Js.Unsafe.inject (Js.string ("Error: " ^ Printexc.to_string exn))

let api_debug_env name_js =
  let name = Js.to_string name_js in
  let id = intern name in
  let found_env = Hashtbl.find_opt global_env.bindings id in
  let found_vm = Hashtbl.find_opt _vm_globals name in
  let total_env = Hashtbl.length global_env.bindings in
  let total_vm = Hashtbl.length _vm_globals in
  let env_s = match found_env with Some v -> "env:" ^ type_of v | None -> "env:MISSING" in
  let vm_s = match found_vm with Some v -> "vm:" ^ type_of v | None -> "vm:MISSING" in
  Js.Unsafe.inject (Js.string (Printf.sprintf "%s %s (env=%d vm=%d)" env_s vm_s total_env total_vm))

let api_compile_module src_js =
  let src = Js.to_string src_js in
  try
    let exprs = Sx_parser.parse_all src in
    let compile_fn = env_get global_env "compile-module" in
    let code = Sx_ref.eval_expr (List [compile_fn; List exprs]) (Env global_env) in
    return_via_side_channel (value_to_js code)
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))
  | Not_found -> Js.Unsafe.inject (Js.string "Error: compile-module not loaded")

let api_render_to_html expr_js =
  let expr = js_to_value expr_js in
  let prev = !_sx_render_mode in
  _sx_render_mode := true;
  (try
    let html = Sx_render.sx_render_to_html global_env expr global_env in
    _sx_render_mode := prev;
    Js.Unsafe.inject (Js.string html)
  with Eval_error msg ->
    _sx_render_mode := prev;
    Js.Unsafe.inject (Js.string ("Error: " ^ msg)))

let api_stringify v_js =
  Js.Unsafe.inject (Js.string (inspect (js_to_value v_js)))

let api_type_of v_js =
  Js.Unsafe.inject (Js.string (type_of (js_to_value v_js)))

let api_inspect v_js =
  Js.Unsafe.inject (Js.string (inspect (js_to_value v_js)))

let api_engine () =
  Js.Unsafe.inject (Js.string "ocaml-vm-wasm")

let api_register_native name_js callback_js =
  let name = Js.to_string name_js in
  let native_fn args =
    let js_args = args |> List.map value_to_js |> Array.of_list in
    js_to_value (Js.Unsafe.fun_call callback_js [| Js.Unsafe.inject (Js.array js_args) |])
  in
  let v = NativeFn (name, native_fn) in
  Sx_primitives.register name native_fn;
  ignore (env_bind global_env name v);
  Hashtbl.replace _vm_globals name v;
  Js.Unsafe.inject Js.null

let api_call_fn fn_js args_js =
  try
    let fn = js_to_value fn_js in
    let args = Array.to_list (Array.map js_to_value (Js.to_array (Js.Unsafe.coerce args_js))) in
    return_via_side_channel (value_to_js (call_sx_fn fn args))
  with
  | Eval_error msg ->
    ignore (Js.Unsafe.meth_call
      (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
      "error" [| Js.Unsafe.inject (Js.string ("[sx] callFn: " ^ msg)) |]);
    Js.Unsafe.inject Js.null
  | exn ->
    ignore (Js.Unsafe.meth_call
      (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
      "error" [| Js.Unsafe.inject (Js.string ("[sx] callFn: " ^ Printexc.to_string exn)) |]);
    Js.Unsafe.inject Js.null

let api_is_callable fn_js =
  if Js.Unsafe.equals fn_js Js.null || Js.Unsafe.equals fn_js Js.undefined then
    Js.Unsafe.inject (Js.bool false)
  else
    let h = Js.Unsafe.get fn_js (Js.string "__sx_handle") in
    if Js.Unsafe.equals h Js.undefined then Js.Unsafe.inject (Js.bool false)
    else Js.Unsafe.inject (Js.bool (is_callable (get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float))))

let api_fn_arity fn_js =
  let h = Js.Unsafe.get fn_js (Js.string "__sx_handle") in
  if Js.Unsafe.equals h Js.undefined then Js.Unsafe.inject (Js.number_of_float (-1.0))
  else
    let v = get_handle (Js.float_of_number (Js.Unsafe.coerce h) |> int_of_float) in
    match v with
    | Lambda l -> Js.Unsafe.inject (Js.number_of_float (float_of_int (List.length l.l_params)))
    | _ -> Js.Unsafe.inject (Js.number_of_float (-1.0))

(* ================================================================== *)
(* Platform bindings (registered in global env)                        *)
(* ================================================================== *)

let () =
  let bind name fn = ignore (env_bind global_env name (NativeFn (name, fn))) in

  (* client? returns true in browser — set the ref so the primitive returns true *)
  Sx_primitives._is_client := true;

  (* --- Evaluation --- *)
  bind "cek-eval" (fun args ->
    match args with
    | [String s] -> let e = Sx_parser.parse_all s in (match e with h :: _ -> Sx_ref.eval_expr h (Env global_env) | [] -> Nil)
    | [expr] -> Sx_ref.eval_expr expr (Env global_env)
    | [expr; env_val] -> Sx_ref.eval_expr expr env_val
    | _ -> raise (Eval_error "cek-eval: expected 1-2 args"));

  bind "eval-expr-cek" (fun args ->
    match args with
    | [expr; e] -> Sx_ref.eval_expr expr e
    | [expr] -> Sx_ref.eval_expr expr (Env global_env)
    | _ -> raise (Eval_error "eval-expr-cek: expected 1-2 args"));

  bind "cek-call" (fun args ->
    match args with
    | [f; a] when is_callable f ->
      let arg_list = match a with List l -> l | Nil -> [] | v -> [v] in
      Sx_ref.trampoline (Sx_runtime.sx_call f arg_list)
    | [f; _] -> raise (Eval_error ("cek-call: not callable: " ^ type_of f))
    | _ -> raise (Eval_error "cek-call: expected (fn args)"));

  bind "sx-parse" (fun args ->
    match args with
    | [String src] -> List (Sx_parser.parse_all src)
    | _ -> raise (Eval_error "sx-parse: expected string"));

  (* parse: same as server — unwraps single results, returns list for multiple.
     Used by boot.sx (page scripts, suspense) and engine.sx (marsh update). *)
  bind "parse" (fun args ->
    match args with
    | [String src] | [SxExpr src] ->
      let exprs = Sx_parser.parse_all src in
      (match exprs with [e] -> e | _ -> List exprs)
    | [v] -> v
    | _ -> raise (Eval_error "parse: expected string"));

  bind "sx-serialize" (fun args ->
    match args with
    | [v] -> String (inspect v)
    | _ -> raise (Eval_error "sx-serialize: expected 1 arg"));

  (* --- Assertions & equality --- *)
  let rec deep_equal a b =
    match a, b with
    | Nil, Nil -> true | Bool a, Bool b -> a = b
    | Number a, Number b -> a = b | String a, String b -> a = b
    | Symbol a, Symbol b -> a = b | Keyword a, Keyword b -> a = b
    | (List a | ListRef { contents = a }), (List b | ListRef { contents = b }) ->
      List.length a = List.length b && List.for_all2 deep_equal a b
    | Dict a, Dict b ->
      let ka = Hashtbl.fold (fun k _ acc -> k :: acc) a [] in
      let kb = Hashtbl.fold (fun k _ acc -> k :: acc) b [] in
      List.length ka = List.length kb &&
      List.for_all (fun k -> Hashtbl.mem b k &&
        deep_equal (Hashtbl.find a k) (Hashtbl.find b k)) ka
    | _ -> false
  in
  bind "equal?" (fun args -> match args with [a; b] -> Bool (deep_equal a b) | _ -> raise (Eval_error "equal?: 2 args"));
  bind "assert" (fun args ->
    match args with
    | [cond] -> if not (sx_truthy cond) then raise (Eval_error "Assertion failed"); Bool true
    | [cond; msg] -> if not (sx_truthy cond) then raise (Eval_error ("Assertion: " ^ value_to_string msg)); Bool true
    | _ -> raise (Eval_error "assert: 1-2 args"));

  bind "try-call" (fun args ->
    match args with
    | [thunk] ->
      (try ignore (Sx_ref.eval_expr (List [thunk]) (Env global_env));
        let d = Hashtbl.create 2 in Hashtbl.replace d "ok" (Bool true); Dict d
      with Eval_error msg ->
        let d = Hashtbl.create 2 in Hashtbl.replace d "ok" (Bool false); Hashtbl.replace d "error" (String msg); Dict d)
    | _ -> raise (Eval_error "try-call: 1 arg"));

  (* --- Bytecode loading from s-expression format ---
     (sxbc version hash (code :arity N :upvalue-count N :bytecode (...) :constants (...)))
     Recursively converts the SX tree into the dict format that loadModule expects. *)
  bind "load-sxbc" (fun args ->
    match args with
    | [List (_ :: _ :: _ :: code_form :: _)] | [List (_ :: _ :: code_form :: _)] ->
      let rec convert_code form =
        match form with
        | List (Symbol "code" :: rest) ->
          let d = Hashtbl.create 8 in
          let rec parse_kv = function
            | Keyword "arity" :: Number n :: rest -> Hashtbl.replace d "arity" (Number n); parse_kv rest
            | Keyword "upvalue-count" :: Number n :: rest -> Hashtbl.replace d "upvalue-count" (Number n); parse_kv rest
            | Keyword "bytecode" :: List nums :: rest ->
              Hashtbl.replace d "bytecode" (List nums); parse_kv rest
            | Keyword "constants" :: List consts :: rest ->
              Hashtbl.replace d "constants" (List (List.map convert_const consts)); parse_kv rest
            | _ :: rest -> parse_kv rest  (* skip unknown keywords *)
            | [] -> ()
          in
          parse_kv rest;
          Dict d
        | _ -> raise (Eval_error ("load-sxbc: expected (code ...), got " ^ type_of form))
      and convert_const = function
        | List (Symbol "code" :: _) as form -> convert_code form
        | List (Symbol "list" :: items) -> List (List.map convert_const items)
        | v -> v  (* strings, numbers, booleans, nil, symbols, keywords pass through *)
      in
      let module_val = convert_code code_form in
      let code = Sx_vm.code_from_value module_val in
      let _result = Sx_vm.execute_module code _vm_globals in
      sync_vm_to_env ();
      Number (float_of_int (Hashtbl.length _vm_globals))
    | _ -> raise (Eval_error "load-sxbc: expected (sxbc version hash (code ...))"));

  (* --- List mutation --- *)
  bind "append!" (fun args ->
    match args with
    | [ListRef r; v] -> r := !r @ [v]; ListRef r
    | [List items; v] -> List (items @ [v])
    | _ -> raise (Eval_error "append!: expected list and value"));

  (* remove! — mutate ListRef in-place, removing by identity (==) *)
  bind "remove!" (fun args ->
    match args with
    | [ListRef r; target] ->
      r := List.filter (fun x -> x != target) !r; ListRef r
    | [List items; target] ->
      List (List.filter (fun x -> x != target) items)
    | _ -> raise (Eval_error "append!: list and value"));

  (* --- Environment ops --- *)
  (* Use unwrap_env for nil/dict tolerance, matching the server kernel *)
  let uw = Sx_runtime.unwrap_env in
  bind "make-env" (fun _ -> Env (make_env ()));
  bind "global-env" (fun _ -> Env global_env);
  bind "env-has?" (fun args -> match args with [e; String k] | [e; Keyword k] -> Bool (env_has (uw e) k) | _ -> raise (Eval_error "env-has?"));
  bind "env-get" (fun args -> match args with [e; String k] | [e; Keyword k] -> env_get (uw e) k | _ -> raise (Eval_error "env-get"));
  bind "env-bind!" (fun args -> match args with [e; String k; v] | [e; Keyword k; v] -> env_bind (uw e) k v | _ -> raise (Eval_error "env-bind!"));
  bind "env-set!" (fun args -> match args with [e; String k; v] | [e; Keyword k; v] -> env_set (uw e) k v | _ -> raise (Eval_error "env-set!"));
  bind "env-extend" (fun args -> match args with [e] -> Env (env_extend (uw e)) | _ -> raise (Eval_error "env-extend"));
  bind "env-merge" (fun args -> match args with [a; b] -> Sx_runtime.env_merge a b | _ -> raise (Eval_error "env-merge"));

  (* --- Type constructors --- *)
  bind "make-symbol" (fun args -> match args with [String s] -> Symbol s | [v] -> Symbol (value_to_string v) | _ -> raise (Eval_error "make-symbol"));
  bind "make-keyword" (fun args -> match args with [String s] -> Keyword s | _ -> raise (Eval_error "make-keyword"));
  bind "keyword-name" (fun args -> match args with [Keyword k] -> String k | _ -> raise (Eval_error "keyword-name"));
  bind "symbol-name" (fun args -> match args with [Symbol s] -> String s | _ -> raise (Eval_error "symbol-name"));

  (* --- Component/Island accessors (must handle both types) --- *)
  bind "component-name" (fun args ->
    match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> String "");
  bind "component-closure" (fun args ->
    match args with [Component c] -> Env c.c_closure | [Island i] -> Env i.i_closure | _ -> Dict (Hashtbl.create 0));
  bind "component-params" (fun args ->
    match args with
    | [Component c] -> List (List.map (fun s -> String s) c.c_params)
    | [Island i] -> List (List.map (fun s -> String s) i.i_params)
    | _ -> Nil);
  bind "component-body" (fun args ->
    match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil);
  let has_children_impl = NativeFn ("component-has-children?", fun args ->
    match args with [Component c] -> Bool c.c_has_children | [Island i] -> Bool i.i_has_children | _ -> Bool false) in
  ignore (env_bind global_env "component-has-children" has_children_impl);
  ignore (env_bind global_env "component-has-children?" has_children_impl);
  bind "component-affinity" (fun args ->
    match args with [Component c] -> String c.c_affinity | [Island _] -> String "client" | _ -> String "auto");
  bind "component-param-types" (fun _ -> Nil);
  bind "component-set-param-types!" (fun _ -> Nil);

  (* --- CEK stepping --- *)
  bind "make-cek-state" (fun args -> match args with [c; e; k] -> Sx_ref.make_cek_state c e k | _ -> raise (Eval_error "make-cek-state"));
  bind "cek-step" (fun args -> match args with [s] -> Sx_ref.cek_step s | _ -> raise (Eval_error "cek-step"));
  bind "cek-phase" (fun args -> match args with [s] -> Sx_ref.cek_phase s | _ -> raise (Eval_error "cek-phase"));
  bind "cek-value" (fun args -> match args with [s] -> Sx_ref.cek_value s | _ -> raise (Eval_error "cek-value"));
  bind "cek-terminal?" (fun args -> match args with [s] -> Sx_ref.cek_terminal_p s | _ -> raise (Eval_error "cek-terminal?"));
  bind "cek-kont" (fun args -> match args with [s] -> Sx_ref.cek_kont s | _ -> raise (Eval_error "cek-kont"));
  bind "frame-type" (fun args -> match args with [f] -> Sx_ref.frame_type f | _ -> raise (Eval_error "frame-type"));

  (* --- Strict mode --- *)
  ignore (env_bind global_env "*strict*" (Bool false));
  ignore (env_bind global_env "*prim-param-types*" Nil);
  bind "set-strict!" (fun args -> match args with [v] -> Sx_ref._strict_ref := v; ignore (env_set global_env "*strict*" v); Nil | _ -> Nil);
  bind "set-prim-param-types!" (fun args -> match args with [v] -> Sx_ref._prim_param_types_ref := v; ignore (env_set global_env "*prim-param-types*" v); Nil | _ -> Nil);
  bind "value-matches-type?" (fun args -> match args with [v; t] -> Sx_ref.value_matches_type_p v t | _ -> Nil);

  (* --- Apply --- *)
  bind "apply" (fun args ->
    match args with
    | f :: rest ->
      let all_args = match List.rev rest with List last :: prefix -> List.rev prefix @ last | _ -> rest in
      Sx_runtime.sx_call f all_args
    | _ -> raise (Eval_error "apply"));

  (* --- Scope stack --- *)
  (* Scope primitives (scope-push!, scope-pop!, context, collect!, collected,
     emit!, emitted, scope-emit!, scope-emitted, etc.) are registered by
     Sx_primitives module initialization in the primitives table.
     The CEK evaluator falls through to the primitives table when a symbol
     isn't in the env, so these work automatically.
     Only provide-push!/provide-pop! need explicit env bindings as aliases. *)
  bind "provide-push!" (fun args -> match args with [n; v] -> Sx_runtime.provide_push n v | _ -> raise (Eval_error "provide-push!"));
  bind "provide-pop!" (fun args -> match args with [n] -> Sx_runtime.provide_pop n | _ -> raise (Eval_error "provide-pop!"));

  (* Runtime helpers for bytecoded defcomp/defisland/defmacro forms.
     The compiler emits GLOBAL_GET "eval-defcomp" + CALL — these must
     exist as callable values for bytecoded .sx files that contain
     component definitions (e.g. cssx.sx). *)
  bind "eval-defcomp" (fun args ->
    match args with [List (_ :: rest)] -> Sx_ref.sf_defcomp (List rest) (Env global_env) | _ -> Nil);
  bind "eval-defisland" (fun args ->
    match args with [List (_ :: rest)] -> Sx_ref.sf_defisland (List rest) (Env global_env) | _ -> Nil);
  bind "eval-defmacro" (fun args ->
    match args with [List (_ :: rest)] -> Sx_ref.sf_defmacro (List rest) (Env global_env) | _ -> Nil);

  (* --- Fragment / raw HTML --- *)
  bind "<>" (fun args ->
    RawHTML (String.concat "" (List.map (fun a ->
      match a with String s | RawHTML s -> s | Nil -> ""
      | List _ -> Sx_render.sx_render_to_html global_env a global_env
      | _ -> value_to_string a) args)));
  bind "raw!" (fun args ->
    RawHTML (String.concat "" (List.map (fun a ->
      match a with String s | RawHTML s -> s | _ -> value_to_string a) args)));

  bind "define-page-helper" (fun _ -> Nil);

  (* IO registry — spec-level defio populates *io-registry* in evaluator.
     Alias as __io-registry for backward compat. *)
  ignore (env_bind global_env "__io-registry" Sx_ref._io_registry_);

  (* --- Render --- *)
  Sx_render.setup_render_env global_env;
  bind "set-render-active!" (fun _ -> Nil);
  bind "render-active?" (fun _ -> Bool true);
  bind "is-html-tag?" (fun args -> match args with [String s] -> Bool (Sx_render.is_html_tag s) | _ -> Bool false);

  (* --- Render constants needed by web adapters --- *)
  let html_tags = List (List.map (fun s -> String s) Sx_render.html_tags) in
  let void_elements = List (List.map (fun s -> String s) Sx_render.void_elements) in
  let boolean_attrs = List (List.map (fun s -> String s) Sx_render.boolean_attrs) in
  ignore (env_bind global_env "HTML_TAGS" html_tags);
  ignore (env_bind global_env "VOID_ELEMENTS" void_elements);
  ignore (env_bind global_env "BOOLEAN_ATTRS" boolean_attrs);

  (* --- HTML tag special forms (div, span, h1, ...) --- *)
  (* Registered as custom special forms so keywords are preserved.
     Handler receives (raw-args env), evaluates non-keyword args
     while keeping keyword names intact. *)
  let eval_tag_args raw_args env =
    let args = Sx_runtime.sx_to_list raw_args in
    let rec process = function
      | [] -> []
      | (Keyword _ as kw) :: value :: rest ->
        (* keyword + its value: keep keyword, evaluate value *)
        kw :: Sx_ref.eval_expr value env :: process rest
      | (Keyword _ as kw) :: [] ->
        (* trailing keyword with no value — boolean attr *)
        [kw]
      | expr :: rest ->
        (* non-keyword: evaluate *)
        Sx_ref.eval_expr expr env :: process rest
    in
    process args
  in
  List.iter (fun tag ->
    ignore (Sx_ref.register_special_form (String tag)
      (NativeFn ("sf:" ^ tag, fun handler_args ->
        match handler_args with
        | [raw_args; env] -> List (Symbol tag :: eval_tag_args raw_args env)
        | _ -> Nil)))
  ) Sx_render.html_tags;

  (* --- Error handling --- *)
  bind "cek-try" (fun args ->
    match args with
    | [thunk; handler] ->
      (try Sx_ref.cek_call thunk Nil
       with Eval_error msg -> Sx_ref.cek_call handler (List [String msg]))
    | [thunk] ->
      (try let r = Sx_ref.cek_call thunk Nil in
        List [Symbol "ok"; r]
       with Eval_error msg -> List [Symbol "error"; String msg])
    | _ -> Nil);

  (* --- Evaluator bridge functions needed by spec .sx files --- *)
  bind "eval-expr" (fun args ->
    match args with [expr; e] -> Sx_ref.eval_expr expr e | [expr] -> Sx_ref.eval_expr expr (Env global_env) | _ -> Nil);
  bind "trampoline" (fun args -> match args with [v] -> !Sx_primitives._sx_trampoline_fn v | _ -> Nil);
  bind "expand-macro" (fun args ->
    match args with [mac; raw; Env e] -> Sx_ref.expand_macro mac raw (Env e) | [mac; raw] -> Sx_ref.expand_macro mac raw (Env global_env) | _ -> Nil);
  bind "call-lambda" (fun args ->
    match args with
    | [f; a; _] | [f; a] when is_callable f ->
      (* Use cek_call instead of sx_call to avoid eval_expr copying
         Dict values (signals). sx_call returns a Thunk resolved via
         eval_expr which deep-copies dicts, breaking signal mutation. *)
      Sx_ref.cek_call f a
    | _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
  bind "cek-call" (fun args ->
    match args with
    | [f; a] when is_callable f ->
      let arg_list = match a with List l -> l | Nil -> [] | v -> [v] in
      Sx_ref.trampoline (Sx_runtime.sx_call f arg_list)
    | [f; _] -> raise (Eval_error ("cek-call: not callable: " ^ type_of f))
    | _ -> raise (Eval_error "cek-call: expected (fn args)"));
  bind "cek-eval" (fun args ->
    match args with [expr] -> Sx_ref.eval_expr expr (Env global_env) | [expr; e] -> Sx_ref.eval_expr expr e | _ -> Nil);
  bind "qq-expand-runtime" (fun args ->
    match args with [template] -> Sx_ref.qq_expand template (Env global_env) | [template; Env e] -> Sx_ref.qq_expand template (Env e) | _ -> Nil);

  (* --- Type predicates needed by adapters --- *)
  bind "thunk?" (fun args -> match args with [Thunk _] -> Bool true | _ -> Bool false);
  bind "thunk-expr" (fun args -> match args with [v] -> thunk_expr v | _ -> Nil);
  bind "thunk-env" (fun args -> match args with [v] -> thunk_env v | _ -> Nil);
  bind "lambda?" (fun args -> match args with [Lambda _] -> Bool true | _ -> Bool false);
  bind "macro?" (fun args -> match args with [Macro _] -> Bool true | _ -> Bool false);
  bind "island?" (fun args -> match args with [Island _] -> Bool true | _ -> Bool false);
  bind "component?" (fun args -> match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
  bind "callable?" (fun args -> match args with [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true | _ -> Bool false);
  bind "spread?" (fun args -> match args with [Spread _] -> Bool true | _ -> Bool false);
  bind "continuation?" (fun args -> match args with [Continuation _] -> Bool true | _ -> Bool false);
  bind "lambda-params" (fun args -> match args with [Lambda l] -> List (List.map (fun s -> String s) l.l_params) | _ -> List []);
  bind "lambda-body" (fun args -> match args with [Lambda l] -> l.l_body | _ -> Nil);
  bind "lambda-closure" (fun args -> match args with [Lambda l] -> Env l.l_closure | _ -> Dict (Hashtbl.create 0));

  (* --- Core operations needed by adapters --- *)
  bind "spread-attrs" (fun args ->
    match args with [Spread pairs] -> let d = Hashtbl.create 4 in List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs; Dict d | _ -> Dict (Hashtbl.create 0));
  bind "make-spread" (fun args ->
    match args with [Dict d] -> Spread (Hashtbl.fold (fun k v acc -> (k, v) :: acc) d []) | _ -> Nil);
  bind "make-raw-html" (fun args -> match args with [String s] -> RawHTML s | [v] -> RawHTML (value_to_string v) | _ -> Nil);
  bind "raw-html-content" (fun args -> match args with [RawHTML s] -> String s | [String s] -> String s | _ -> String "");
  bind "empty-dict?" (fun args -> match args with [Dict d] -> Bool (Hashtbl.length d = 0) | _ -> Bool true);
  bind "identical?" (fun args -> match args with [a; b] -> Bool (a == b) | _ -> raise (Eval_error "identical?"));
  bind "for-each-indexed" (fun args ->
    match args with
    | [fn_val; List items] | [fn_val; ListRef { contents = items }] ->
      List.iteri (fun i item ->
        ignore (Sx_ref.eval_expr (List [fn_val; Number (float_of_int i); item]) (Env global_env))
      ) items; Nil
    | _ -> Nil);

  (* --- String/number helpers used by orchestration/browser --- *)
  bind "make-sx-expr" (fun args -> match args with [String s] -> SxExpr s | _ -> raise (Eval_error "make-sx-expr"));
  bind "sx-expr-source" (fun args -> match args with [SxExpr s] -> String s | [String s] -> String s | _ -> raise (Eval_error "sx-expr-source"));
  bind "parse-int" (fun args ->
    match args with
    | [String s] -> (try Number (float_of_int (int_of_string s)) with _ -> Nil)
    | [String s; default_val] -> (try Number (float_of_int (int_of_string s)) with _ -> default_val)
    | [Number n] | [Number n; _] -> Number (Float.round n)
    | [_; default_val] -> default_val | _ -> Nil);
  bind "parse-number" (fun args -> match args with [String s] -> (try Number (float_of_string s) with _ -> Nil) | _ -> Nil);

  (* --- Server-only stubs (no-ops in browser) --- *)
  bind "query" (fun _ -> Nil);
  bind "action" (fun _ -> Nil);
  bind "request-arg" (fun args -> match args with [_; d] -> d | _ -> Nil);
  bind "request-method" (fun _ -> String "GET");
  bind "ctx" (fun _ -> Nil);
  bind "helper" (fun _ -> Nil);
  ()

(* ================================================================== *)
(* JIT compilation hook                                                *)
(*                                                                     *)
(* On first call to a named lambda, try to compile it to bytecode via  *)
(* compiler.sx (loaded as an .sx platform file). Compiled closures run *)
(* on the bytecode VM; failures fall back to the CEK interpreter.      *)
(* ================================================================== *)

let _jit_compiling = ref false
let _jit_enabled = ref false

let () =
  Sx_runtime._jit_try_call_fn := Some (fun f args ->
    match f with
    | Lambda l when !_jit_enabled ->
      (match l.l_compiled with
       | Some cl when not (Sx_vm.is_jit_failed cl) ->
         (try Some (Sx_vm.call_closure cl args _vm_globals)
          with Eval_error msg ->
            let fn_name = match l.l_name with Some n -> n | None -> "?" in
            Printf.eprintf "[jit] FAIL %s: %s (bc=%d consts=%d upv=%d)\n%!"
              fn_name msg
              (Array.length cl.vm_code.vc_bytecode)
              (Array.length cl.vm_code.vc_constants)
              (Array.length cl.vm_upvalues);
            (* Mark as failed to stop retrying *)
            l.l_compiled <- Some (Sx_vm.jit_failed_sentinel);
            None)
       | Some _ -> None
       | None ->
         if !_jit_compiling then None
         else begin
           _jit_compiling := true;
           let compiled = Sx_vm.jit_compile_lambda l _vm_globals in
           _jit_compiling := false;
           (match compiled with
           | Some cl ->
             l.l_compiled <- Some cl;
             (try Some (Sx_vm.call_closure cl args _vm_globals)
              with Eval_error msg ->
                let fn_name2 = match l.l_name with Some n -> n | None -> "?" in
                Printf.eprintf "[jit] FAIL %s: %s (bc=%d consts=%d upv=%d)\n%!"
                  fn_name2 msg
                  (Array.length cl.vm_code.vc_bytecode)
                  (Array.length cl.vm_code.vc_constants)
                  (Array.length cl.vm_upvalues);
                l.l_compiled <- Some (Sx_vm.jit_failed_sentinel);
                None)
           | None -> None)
         end)
    | _ -> None)

let () = ignore (env_bind global_env "enable-jit!" (NativeFn ("enable-jit!", fun _ -> _jit_enabled := true; Nil)))

(* Seed BOTH _vm_globals AND global_env with ALL primitives as NativeFn values.
   Unconditional — native primitives are authoritative for CALL_PRIM dispatch.
   Must be in both because sync_env_to_vm() copies global_env → _vm_globals. *)
let () =
  Hashtbl.iter (fun name fn ->
    let v = NativeFn (name, fn) in
    Hashtbl.replace _vm_globals name v;
    Hashtbl.replace global_env.bindings (intern name) v
  ) Sx_primitives.primitives

(* ================================================================== *)
(* Register global SxKernel object                                     *)
(* ================================================================== *)

let () =
  let sx = Js.Unsafe.obj [||] in
  let wrap fn = Js.Unsafe.fun_call
    (Js.Unsafe.pure_js_expr "(function(fn) { return function() { globalThis.__sxR = undefined; var r = fn.apply(null, arguments); return globalThis.__sxR !== undefined ? globalThis.__sxR : r; }; })")
    [| Js.Unsafe.inject (Js.wrap_callback fn) |] in

  Js.Unsafe.set sx (Js.string "parse") (Js.wrap_callback api_parse);
  Js.Unsafe.set sx (Js.string "stringify") (Js.wrap_callback api_stringify);
  Js.Unsafe.set sx (Js.string "eval") (wrap api_eval);
  Js.Unsafe.set sx (Js.string "evalVM") (wrap api_eval_vm);
  Js.Unsafe.set sx (Js.string "evalExpr") (wrap api_eval_expr);
  Js.Unsafe.set sx (Js.string "renderToHtml") (Js.wrap_callback api_render_to_html);
  Js.Unsafe.set sx (Js.string "load") (Js.wrap_callback api_load);
  Js.Unsafe.set sx (Js.string "loadModule") (Js.wrap_callback api_load_module);
  Js.Unsafe.set sx (Js.string "beginModuleLoad") (Js.wrap_callback (fun () -> api_begin_module_load ()));
  Js.Unsafe.set sx (Js.string "endModuleLoad") (Js.wrap_callback (fun () -> api_end_module_load ()));
  Js.Unsafe.set sx (Js.string "compileModule") (wrap api_compile_module);
  Js.Unsafe.set sx (Js.string "typeOf") (Js.wrap_callback api_type_of);
  Js.Unsafe.set sx (Js.string "inspect") (Js.wrap_callback api_inspect);
  Js.Unsafe.set sx (Js.string "engine") (Js.wrap_callback api_engine);
  Js.Unsafe.set sx (Js.string "registerNative") (Js.wrap_callback api_register_native);
  Js.Unsafe.set sx (Js.string "loadSource") (Js.wrap_callback api_load);
  Js.Unsafe.set sx (Js.string "callFn") (wrap api_call_fn);
  Js.Unsafe.set sx (Js.string "isCallable") (Js.wrap_callback api_is_callable);
  Js.Unsafe.set sx (Js.string "fnArity") (Js.wrap_callback api_fn_arity);
  Js.Unsafe.set sx (Js.string "debugEnv") (Js.wrap_callback api_debug_env);

  (* Scope tracing API *)
  Js.Unsafe.set sx (Js.string "scopeTraceOn") (Js.wrap_callback (fun () ->
    Sx_primitives.scope_trace_enable (); Js.Unsafe.inject Js.null));
  Js.Unsafe.set sx (Js.string "scopeTraceOff") (Js.wrap_callback (fun () ->
    Sx_primitives.scope_trace_disable (); Js.Unsafe.inject Js.null));
  Js.Unsafe.set sx (Js.string "scopeTraceDrain") (Js.wrap_callback (fun () ->
    let log = Sx_primitives.scope_trace_drain () in
    Js.Unsafe.inject (Js.array (Array.of_list (List.map (fun s -> Js.Unsafe.inject (Js.string s)) log)))));

  Js.Unsafe.set Js.Unsafe.global (Js.string "SxKernel") sx