(** Runtime helpers for transpiled code.

    These bridge the gap between the transpiler's output and the
    foundation types/primitives. The transpiled evaluator calls these
    functions directly. *)

open Sx_types

(** Fast path equality — same as Sx_primitives.safe_eq for the common cases
    that show up in hot dispatch (string vs string, etc). Falls through to
    the registered "=" primitive for complex cases. *)
let rec _fast_eq a b =
  if a == b then true
  else match a, b with
  | String x, String y -> x = y
  | Integer x, Integer y -> x = y
  | Number x, Number y -> x = y
  | Integer x, Number y -> float_of_int x = y
  | Number x, Integer y -> x = float_of_int y
  | Bool x, Bool y -> x = y
  | Nil, Nil -> true
  | Symbol x, Symbol y -> x = y
  | Keyword x, Keyword y -> x = y
  | List la, List lb ->
    (try List.for_all2 _fast_eq la lb with Invalid_argument _ -> false)
  | _ -> false

(** Call a registered primitive by name.
    Fast path for hot dispatch primitives ([=], [<], [>], [<=], [>=], [empty?],
    [first], [rest], [len]) skips the Hashtbl lookup entirely — these are
    called millions of times in the CEK [step_continue]/[step_eval] dispatch. *)
let prim_call name args =
  (* Hot path: most-frequently-called primitives by step_continue dispatch *)
  match name, args with
  | "=", [a; b] -> Bool (_fast_eq a b)
  | "empty?", [List []] -> Bool true
  | "empty?", [List _] -> Bool false
  | "empty?", [ListRef { contents = [] }] -> Bool true
  | "empty?", [ListRef _] -> Bool false
  | "empty?", [Nil] -> Bool true
  | "first", [List (x :: _)] -> x
  | "first", [List []] -> Nil
  | "first", [ListRef { contents = (x :: _) }] -> x
  | "first", [ListRef _] -> Nil
  | "first", [Nil] -> Nil
  | "rest", [List (_ :: xs)] -> List xs
  | "rest", [List []] -> List []
  | "rest", [ListRef { contents = (_ :: xs) }] -> List xs
  | "rest", [ListRef _] -> List []
  | "rest", [Nil] -> List []
  | "len", [List l] -> Integer (List.length l)
  | "len", [ListRef r] -> Integer (List.length !r)
  | "len", [String s] -> Integer (String.length s)
  | "len", [Nil] -> Integer 0
  | "<", [Integer x; Integer y] -> Bool (x < y)
  | "<", [Number x; Number y] -> Bool (x < y)
  | "<", [Integer x; Number y] -> Bool (float_of_int x < y)
  | "<", [Number x; Integer y] -> Bool (x < float_of_int y)
  | ">", [Integer x; Integer y] -> Bool (x > y)
  | ">", [Number x; Number y] -> Bool (x > y)
  | ">", [Integer x; Number y] -> Bool (float_of_int x > y)
  | ">", [Number x; Integer y] -> Bool (x > float_of_int y)
  | "<=", [Integer x; Integer y] -> Bool (x <= y)
  | "<=", [Number x; Number y] -> Bool (x <= y)
  | "<=", [Integer x; Number y] -> Bool (float_of_int x <= y)
  | "<=", [Number x; Integer y] -> Bool (x <= float_of_int y)
  | ">=", [Integer x; Integer y] -> Bool (x >= y)
  | ">=", [Number x; Number y] -> Bool (x >= y)
  | ">=", [Integer x; Number y] -> Bool (float_of_int x >= y)
  | ">=", [Number x; Integer y] -> Bool (x >= float_of_int y)
  | _ ->
    match Hashtbl.find_opt Sx_primitives.primitives name with
    | Some f -> f args
    | None -> raise (Eval_error ("Unknown primitive: " ^ name))

(** Convert any SX value to an OCaml string (internal). *)
let value_to_str = function
  | String s -> s
  | Number n -> Sx_types.format_number n
  | Bool true -> "true"
  | Bool false -> "false"
  | Nil -> ""
  | Symbol s -> s
  | Keyword k -> k
  | v -> inspect v

(** sx_to_string returns a value (String) for transpiled code. *)
let sx_to_string v = String (value_to_str v)

(** String concatenation helper — [sx_str] takes a list of values. *)
let sx_str args =
  String.concat "" (List.map value_to_str args)

(** Convert a value to a list. *)
let sx_to_list = function
  | List l -> l
  | ListRef r -> !r
  | Nil -> []
  | v -> raise (Eval_error ("Expected list, got " ^ type_of v))

(** Call an SX callable (lambda, native fn, continuation). *)
let sx_call f args =
  match f with
  | NativeFn (_, fn) -> fn args
  | VmClosure cl -> !Sx_types._vm_call_closure_ref cl args
  | Lambda _ ->
    !Sx_types._cek_eval_lambda_ref f args
  | Continuation (k, _) ->
    k (match args with x :: _ -> x | [] -> Nil)
  | CallccContinuation (_, _) ->
    raise (Eval_error "callcc continuations must be invoked through the CEK machine")
  | _ ->
    let nargs = List.length args in
    let args_preview = if nargs = 0 then "" else
      let s = String.concat ", " (List.map (fun a -> let s = inspect a in if String.length s > 40 then String.sub s 0 40 ^ ".." else s) args) in
      " with args=[" ^ s ^ "]" in
    raise (Eval_error ("Not callable: " ^ inspect f ^ args_preview))

(* Initialize forward ref so primitives can call SX functions *)
let () = Sx_primitives._sx_call_fn := sx_call
(* Trampoline ref is set by sx_ref.ml after it's loaded *)

(** Apply a function to a list of args. *)
let sx_apply f args_list =
  sx_call f (sx_to_list args_list)

(** CEK-safe apply — catches Eval_error from native fns and returns an error
    marker dict instead of raising.  The CEK evaluator checks for this and
    converts to a raise-eval state so guard/handler-bind can intercept it.
    Non-native calls (lambda, continuation) delegate to sx_apply unchanged. *)
let sx_apply_cek f args_list =
  match f with
  | NativeFn _ | VmClosure _ ->
    (try sx_apply f args_list
     with
     | CekPerformRequest _ as e -> raise e
     | exn ->
       (* Check if this is a VM suspension — return marker dict so
          continue_with_call can build a proper suspended CEK state
          with vm-resume-frame on the kont. *)
       (match !_vm_suspension_to_dict exn with
        | Some marker -> marker
        | None ->
          (match exn with
           | Eval_error msg ->
             let d = Hashtbl.create 3 in
             Hashtbl.replace d "__eval_error__" (Bool true);
             Hashtbl.replace d "message" (String msg);
             Dict d
           | _ -> raise exn)))
  | _ -> sx_apply f args_list

(** Check if a value is an eval-error marker from sx_apply_cek. *)
let is_eval_error v =
  match v with
  | Dict d -> (match Hashtbl.find_opt d "__eval_error__" with
    | Some (Bool true) -> true | _ -> false)
  | _ -> false

(** Mutable append — add item to a list ref or accumulator.
    In transpiled code, lists that get appended to are mutable refs. *)
let sx_append_b lst item =
  match lst with
  | List items -> List (items @ [item])
  | ListRef r -> r := !r @ [item]; lst  (* mutate in place, return same ref *)
  | _ -> raise (Eval_error ("append!: expected list, got " ^ type_of lst))

(** Mutable dict-set — set key in dict, return value. *)
let sx_dict_set_b d k v =
  match d, k with
  | Dict tbl, String key -> Hashtbl.replace tbl key v; v
  | Dict tbl, Keyword key -> Hashtbl.replace tbl key v; v
  | CekFrame f, String key ->
    (match key with
     | "value" | "extra" | "ho-type" | "scheme" | "indexed"
     | "phase" | "has-effects" | "match-val" | "current-item"
     | "update-fn" | "head-name" -> f.cf_extra <- v; v
     | "remaining" -> f.cf_remaining <- v; v
     | "subscribers" | "results" | "raw-args" -> f.cf_results <- v; v
     | "emitted" | "effect-list" | "first-render" | "extra2" -> f.cf_extra2 <- v; v
     | _ -> raise (Eval_error ("dict-set! cek-frame: unknown field " ^ key)))
  | VmFrame f, String key ->
    (match key with
     | "ip" -> f.vf_ip <- val_to_int v; v
     | _ -> raise (Eval_error ("dict-set! vm-frame: unknown field " ^ key)))
  | VmMachine m, String key ->
    (match key with
     | "sp" -> m.vm_sp <- val_to_int v; v
     | "frames" -> m.vm_frames <- (match v with List l -> List.map (fun x -> match x with VmFrame f -> f | _ -> raise (Eval_error "vm: frames must be vm-frame list")) l | _ -> []); v
     | "stack" -> (match v with List _ -> v | _ -> raise (Eval_error "vm: stack must be array"))
     | _ -> raise (Eval_error ("dict-set! vm-machine: unknown field " ^ key)))
  | _ -> raise (Eval_error "dict-set!: expected dict and string key")

(** Get from dict or list. *)
let get_val container key =
  match container, key with
  | CekState s, String k ->
    (match k with
     | "control" -> s.cs_control | "env" -> s.cs_env
     | "kont" -> s.cs_kont | "phase" -> String s.cs_phase
     | "value" -> s.cs_value | _ -> Nil)
  | CekFrame f, String k ->
    (match k with
     | "type" -> String f.cf_type | "env" -> f.cf_env
     | "name" -> f.cf_name | "body" -> f.cf_body
     | "remaining" -> f.cf_remaining | "f" -> f.cf_f
     | "args" -> f.cf_args | "evaled" -> f.cf_args
     | "results" -> f.cf_results | "raw-args" -> f.cf_results
     | "then" -> f.cf_body | "else" -> f.cf_name
     | "ho-type" -> f.cf_extra | "scheme" -> f.cf_extra
     | "indexed" -> f.cf_extra | "value" -> f.cf_extra
     | "phase" -> f.cf_extra | "has-effects" -> f.cf_extra
     | "match-val" -> f.cf_extra | "current-item" -> f.cf_extra
     | "update-fn" -> f.cf_extra | "head-name" -> f.cf_extra
     | "emitted" -> f.cf_extra2 | "effect-list" -> f.cf_extra2
     | "first-render" -> f.cf_extra2 | "file" -> f.cf_env
     | "extra" -> f.cf_extra | "extra2" -> f.cf_extra2
     | "subscribers" -> f.cf_results
     | "prev-tracking" -> f.cf_extra
     | "after-thunk" -> f.cf_f        (* wind-after frame *)
     | "winders-len" -> f.cf_extra    (* wind-after frame *)
     | "body-result" -> f.cf_name     (* wind-return frame *)
     | _ -> Nil)
  | VmFrame f, String k ->
    (match k with
     | "ip" -> Number (float_of_int f.vf_ip)
     | "closure" -> VmClosure f.vf_closure
     | "base" -> Number (float_of_int f.vf_base)
     | "local-cells" -> Nil  (* opaque — accessed via frame-local-get/set *)
     | _ -> Nil)
  | VmMachine m, String k ->
    (match k with
     | "sp" -> Number (float_of_int m.vm_sp)
     | "stack" -> Nil  (* opaque — accessed via vm-push/pop *)
     | "frames" -> List (List.map (fun f -> VmFrame f) m.vm_frames)
     | "globals" -> Dict m.vm_globals
     | _ -> Nil)
  | VmClosure cl, String k ->
    (match k with
     | "vm-code" ->
       (* Return vm_code fields as a Dict.  The bytecode and constants arrays
          are lazily converted to Lists and cached on the vm_code record so
          the transpiled VM loop (which re-derives bc/consts each iteration)
          doesn't allocate on every step. *)
       let c = cl.vm_code in
       let bc = match c.vc_bytecode_list with
         | Some l -> l
         | None ->
           let l = Array.to_list (Array.map (fun i -> Number (float_of_int i)) c.vc_bytecode) in
           c.vc_bytecode_list <- Some l; l in
       let consts = match c.vc_constants_list with
         | Some l -> l
         | None ->
           let l = Array.to_list c.vc_constants in
           c.vc_constants_list <- Some l; l in
       let d = Hashtbl.create 4 in
       Hashtbl.replace d "vc-bytecode" (List bc);
       Hashtbl.replace d "vc-constants" (List consts);
       Hashtbl.replace d "vc-arity" (Number (float_of_int c.vc_arity));
       Hashtbl.replace d "vc-rest-arity" (Number (float_of_int c.vc_rest_arity));
       Hashtbl.replace d "vc-locals" (Number (float_of_int c.vc_locals));
       Dict d
     | "vm-upvalues" ->
       List (Array.to_list (Array.map (fun uv -> uv.uv_value) cl.vm_upvalues))
     | "vm-name" ->
       (match cl.vm_name with Some n -> String n | None -> Nil)
     | "vm-globals" -> Dict cl.vm_env_ref
     | "vm-closure-env" ->
       (match cl.vm_closure_env with Some e -> Env e | None -> Nil)
     | _ -> Nil)
  | Dict d, String k -> dict_get d k
  | Dict d, Keyword k -> dict_get d k
  | AdtValue a, String k | AdtValue a, Keyword k ->
    (match k with
     | "_adt"    -> Bool true
     | "_type"   -> String a.av_type
     | "_ctor"   -> String a.av_ctor
     | "_fields" -> List (Array.to_list a.av_fields)
     | _         -> Nil)
  | (List l | ListRef { contents = l }), Number n ->
    (try List.nth l (int_of_float n) with _ -> Nil)
  | (List l | ListRef { contents = l }), Integer n ->
    (try List.nth l n with _ -> Nil)
  | Nil, _ -> Nil  (* nil.anything → nil *)
  | _, _ -> Nil    (* type mismatch → nil (matches JS/Python behavior) *)

(** Register get as a primitive override — transpiled code calls (get d k). *)
let () =
  Sx_primitives.register "get" (fun args ->
    match args with
    | [c; k] -> get_val c k
    | [c; k; default] ->
      (try
        let v = get_val c k in
        if v = Nil then default else v
      with _ -> default)
    | _ -> raise (Eval_error "get: 2-3 args"))


(* ====================================================================== *)
(* Primitive aliases — top-level functions called by transpiled code       *)
(* ====================================================================== *)

(** The transpiled evaluator calls primitives directly by their mangled
    OCaml name. These aliases delegate to the primitives table so the
    transpiled code compiles without needing [prim_call] everywhere. *)

let _prim name = match Hashtbl.find_opt Sx_primitives.primitives name with
  | Some f -> f | None -> (fun _ -> raise (Eval_error ("Missing prim: " ^ name)))

(* Collection ops *)
let first args = _prim "first" [args]
let rest args = _prim "rest" [args]
let last args = _prim "last" [args]
let nth coll i = _prim "nth" [coll; i]
let cons x l = _prim "cons" [x; l]
let append a b = _prim "append" [a; b]
let reverse l = _prim "reverse" [l]
let flatten l = _prim "flatten" [l]
let concat a b = _prim "concat" [a; b]
let slice a b = _prim "slice" [a; b]
let len a = _prim "len" [a]
let get a b = get_val a b
let sort' a = _prim "sort" [a]
let range' a = _prim "range" [a]
let unique a = _prim "unique" [a]
let zip a b = _prim "zip" [a; b]
let take a b = _prim "take" [a; b]
let drop a b = _prim "drop" [a; b]

(* Predicates *)
let keyword_p a = _prim "keyword?" [a]
let empty_p a = _prim "empty?" [a]
let number_p a = _prim "number?" [a]
let string_p a = _prim "string?" [a]
let boolean_p a = _prim "boolean?" [a]
let list_p a = _prim "list?" [a]
let dict_p a = _prim "dict?" [a]
let symbol_p a = _prim "symbol?" [a]

(* String ops *)
let str' args = String (sx_str args)
let upper a = _prim "upper" [a]
let upcase a = _prim "upcase" [a]
let lower a = _prim "lower" [a]
let downcase a = _prim "downcase" [a]
let trim a = _prim "trim" [a]
let split a b = _prim "split" [a; b]
let join a b = _prim "join" [a; b]
let replace a b c = _prim "replace" [a; b; c]
let substring a b c = _prim "substring" [a; b; c]

(* Dict ops *)
let assoc d k v = _prim "assoc" [d; k; v]
let dissoc d k = _prim "dissoc" [d; k]
let merge' a b = _prim "merge" [a; b]
let keys a = _prim "keys" [a]
let vals a = _prim "vals" [a]
let dict_set a b c = _prim "dict-set!" [a; b; c]
let dict_get a b = _prim "dict-get" [a; b]
let dict_delete a b = _prim "dict-delete!" [a; b]

(* Math *)
let abs' a = _prim "abs" [a]
let sqrt' a = _prim "sqrt" [a]
let pow' a b = _prim "pow" [a; b]
let floor' a = _prim "floor" [a]
let ceil' a = _prim "ceil" [a]
let round' a = _prim "round" [a]
let min' a b = _prim "min" [a; b]
let max' a b = _prim "max" [a; b]
let clamp a b c = _prim "clamp" [a; b; c]

(* Misc *)
let error msg = raise (Eval_error (value_to_str msg))

(* inspect wrapper — returns String value instead of OCaml string *)
let inspect v = String (Sx_types.inspect v)
let apply' f args = sx_apply f args
let spread_attrs a = _prim "spread-attrs" [a]

let sx_context a b = prim_call "context" [a; b]

(* Trampoline — forward-declared in sx_ref.ml, delegates to CEK eval_expr *)
(* This is a stub; the real trampoline is wired up in sx_ref.ml after eval_expr is defined *)
let trampoline v = v

(* Value-returning type predicates — the transpiled code passes these through
   sx_truthy, so they need to return Bool, not OCaml bool. *)
(* type_of returns value, not string *)
let type_of v = String (Sx_types.type_of v)

(* Env operations — accept Env-wrapped values and value keys.
   The transpiled CEK machine stores envs in dicts as Env values. *)
let unwrap_env = function
  | Env e -> e
  | Dict d ->
    (* Dict used as env — wrap it. Needed by adapter-html.sx which
       passes dicts as env args (e.g. empty {} as caller env). *)
    let e = Sx_types.make_env () in
    Hashtbl.iter (fun k v -> ignore (Sx_types.env_bind e k v)) d;
    e
  | Nil ->
    Sx_types.make_env ()
  | v -> raise (Eval_error ("Expected env, got " ^ Sx_types.type_of v))

let env_has e name = Bool (Sx_types.env_has (unwrap_env e) (value_to_str name))
let env_get e name = Sx_types.env_get (unwrap_env e) (value_to_str name)
let env_bind e name v = Sx_types.env_bind (unwrap_env e) (value_to_str name) v
let env_set e name v = Sx_types.env_set (unwrap_env e) (value_to_str name) v

let make_env () = Env (Sx_types.make_env ())
let env_extend e = Env (Sx_types.env_extend (unwrap_env e))
let env_merge a b = Env (Sx_types.env_merge (unwrap_env a) (unwrap_env b))

(* set_lambda_name wrapper — accepts value, extracts string *)
let set_lambda_name l n = Sx_types.set_lambda_name l (value_to_str n)

let is_nil v = Bool (Sx_types.is_nil v)
let is_thunk v = Bool (Sx_types.is_thunk v)
let is_lambda v = Bool (Sx_types.is_lambda v)
let is_component v = Bool (Sx_types.is_component v)
let is_island v = Bool (Sx_types.is_island v)
let is_macro v = Bool (Sx_types.is_macro v)
let is_signal v = Bool (Sx_types.is_signal v)
let is_callable v = Bool (Sx_types.is_callable v)
let is_primitive name = Bool (Sx_primitives.is_primitive (value_to_str name))
let get_primitive name = Sx_primitives.get_primitive (value_to_str name)

(* Stubs for functions defined in sx_ref.ml — resolved at link time *)
(* These are forward-declared here; sx_ref.ml defines the actual implementations *)

(* strip-prefix *)
(* Stubs for evaluator functions — defined in sx_ref.ml but
   sometimes referenced before their definition via forward calls.
   These get overridden by the actual transpiled definitions. *)

let for_each_indexed fn coll =
  List.iteri (fun i x -> ignore (sx_call fn [Number (float_of_int i); x])) (sx_to_list coll);
  Nil

(* Continuation support *)
let continuation_p v = match v with Continuation (_, _) -> Bool true | _ -> Bool false

let make_cek_continuation captured rest_kont =
  let data = Hashtbl.create 2 in
  Hashtbl.replace data "captured" captured;
  Hashtbl.replace data "rest-kont" rest_kont;
  Continuation ((fun v -> v), Some data)

let continuation_data v = match v with
  | Continuation (_, Some d) -> Dict d
  | Continuation (_, None) -> Dict (Hashtbl.create 0)
  | _ -> raise (Eval_error "not a continuation")

(* Callcc (undelimited) continuation support *)
let callcc_continuation_p v = match v with CallccContinuation (_, _) -> Bool true | _ -> Bool false

let make_callcc_continuation captured winders_len =
  let n = match winders_len with Number f -> int_of_float f | Integer n -> n | _ -> 0 in
  CallccContinuation (sx_to_list captured, n)

let callcc_continuation_data v = match v with
  | CallccContinuation (frames, _) -> List frames
  | _ -> raise (Eval_error "not a callcc continuation")

let callcc_continuation_winders_len v = match v with
  | CallccContinuation (_, n) -> Number (float_of_int n)
  | _ -> Number 0.0

(* Dynamic wind — simplified for OCaml (no async) *)
let host_error msg =
  raise (Eval_error (value_to_str msg))

let host_warn msg =
  prerr_endline (value_to_str msg);
  Nil

let dynamic_wind_call before body after _env =
  ignore (sx_call before []);
  let result = sx_call body [] in
  ignore (sx_call after []);
  result

(* Scope stack — all delegated to primitives registered in sx_server.ml *)
let scope_push name value = prim_call "scope-push!" [name; value]
let scope_pop name = prim_call "scope-pop!" [name]
let scope_peek name = prim_call "scope-peek" [name]
let scope_emit name value = prim_call "scope-emit!" [name; value]
let provide_push name value = prim_call "scope-push!" [name; value]
let provide_pop name = prim_call "scope-pop!" [name]

(* Custom special forms registry — mutable dict *)
let custom_special_forms = Dict (Hashtbl.create 4)

(* register-special-form! — add a handler to the custom registry *)
let register_special_form name handler =
  (match custom_special_forms with
   | Dict tbl -> Hashtbl.replace tbl (value_to_str name) handler; handler
   | _ -> raise (Eval_error "custom_special_forms not a dict"))

(* Render check/fn hooks — nil by default, set by platform if needed *)
let render_check = Nil
let render_fn = Nil

(* is-else-clause? — check if a cond/case test is an else marker *)
let is_else_clause v =
  match v with
  | Keyword k -> Bool (k = "else" || k = "default")
  | Symbol s -> Bool (s = "else" || s = "default")
  | Bool true -> Bool true
  | _ -> Bool false

(* Signal accessors *)
let signal_value s = match s with
  | Signal sig' -> sig'.s_value
  | Dict d -> (match Hashtbl.find_opt d "value" with Some v -> v | None -> Nil)
  | _ -> raise (Eval_error "not a signal")
let signal_add_sub_b s f =
  match s with
  | Dict d ->
    (match Hashtbl.find_opt d "subscribers" with
     | Some (ListRef r) -> r := !r @ [f]; Nil
     | Some (List items) -> Hashtbl.replace d "subscribers" (ListRef (ref (items @ [f]))); Nil
     | _ -> Hashtbl.replace d "subscribers" (ListRef (ref [f])); Nil)
  | _ -> Nil

let signal_remove_sub_b s f =
  match s with
  | Dict d ->
    (match Hashtbl.find_opt d "subscribers" with
     | Some (ListRef r) -> r := List.filter (fun x -> x != f) !r; Nil
     | Some (List items) -> Hashtbl.replace d "subscribers" (List (List.filter (fun x -> x != f) items)); Nil
     | _ -> Nil)
  | _ -> Nil

(* Island scope stubs — accept both bare OCaml fns and NativeFn values
   from transpiled code (NativeFn wrapping for value-storable lambdas). *)
let with_island_scope _register_fn body_fn =
  match body_fn with
  | NativeFn (_, f) -> f []
  | _ -> Nil
let register_in_scope _dispose_fn = Nil

(* Component type annotation stub *)
let component_set_param_types_b _comp _types = Nil

(* Parse keyword args from a call — this is defined in evaluator.sx,
   the transpiled version will override this stub. *)
(* Forward-reference stubs for evaluator functions used before definition *)
let parse_comp_params _params = List [List []; Nil; Bool false]
let parse_macro_params _params = List [List []; Nil]

let parse_keyword_args _raw_args _env =
  (* Stub — the real implementation is transpiled from evaluator.sx *)
  List [Dict (Hashtbl.create 0); List []]

(* Make handler def — used by custom_special_forms *)
let make_handler_def name params body _env = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "handler"); Hashtbl.replace d "name" name; Hashtbl.replace d "params" params; Hashtbl.replace d "body" body; d)
let make_page_def name _opts = Dict (let d = Hashtbl.create 4 in Hashtbl.replace d "type" (String "page"); Hashtbl.replace d "name" name; d)

(* sf_defhandler — used by custom_special_forms *)
let sf_defhandler args env =
  let name = first args in let rest_args = rest args in
  make_handler_def name (first rest_args) (nth rest_args (Number 1.0)) env

let strip_prefix s prefix =
  match s, prefix with
  | String s, String p ->
    let pl = String.length p in
    if String.length s >= pl && String.sub s 0 pl = p
    then String (String.sub s pl (String.length s - pl))
    else String s
  | _ -> s

(* debug_log — no-op in production, used by CEK evaluator for component warnings *)
let debug_log _ _ = Nil

(* mutable_list — mutable list for bytecode compiler pool entries *)
let mutable_list () = ListRef (ref [])

(* JIT try-call — ref set by sx_server.ml after compiler loads.
   Returns Nil (no JIT) or the result value. Spec calls this. *)
let _jit_try_call_fn : (value -> value list -> value option) option ref = ref None
let _jit_hit = ref 0
let _jit_miss = ref 0
let _jit_skip = ref 0
let jit_reset_counters () = _jit_hit := 0; _jit_miss := 0; _jit_skip := 0
(* Sentinel value for "JIT skipped — fall back to CEK".
   Must be distinguishable from any legitimate return value including Nil.
   We use a unique tagged dict that is_jit_skip can identify. *)
let _jit_skip_sentinel =
  let d = Hashtbl.create 1 in
  Hashtbl.replace d "__jit_skip" (Bool true);
  Dict d

let is_jit_skip v = match v with
  | Dict d -> Hashtbl.mem d "__jit_skip"
  | _ -> false

(* Platform function for the spec: (jit-skip? v) → transpiles to jit_skip_p *)
let jit_skip_p v = Bool (is_jit_skip v)

let jit_try_call f args =
  match !_jit_try_call_fn with
  | None -> incr _jit_skip; _jit_skip_sentinel
  | Some hook ->
    match f with
    | Lambda l when l.l_name <> None ->
      let arg_list = match args with List a | ListRef { contents = a } -> a | _ -> [] in
      (match hook f arg_list with Some result -> incr _jit_hit; result | None -> incr _jit_miss; _jit_skip_sentinel)
    | _ -> incr _jit_skip; _jit_skip_sentinel


