(** Built-in primitive functions (~80 pure functions).

    Registered in a global table; the evaluator checks this table
    when a symbol isn't found in the lexical environment. *)

open Sx_types

let primitives : (string, value list -> value) Hashtbl.t = Hashtbl.create 128

(** Forward refs for calling SX functions from primitives (breaks cycle). *)
let _sx_call_fn : (value -> value list -> value) ref =
  ref (fun _ _ -> raise (Eval_error "sx_call not initialized"))
let _sx_trampoline_fn : (value -> value) ref =
  ref (fun v -> v)
let _is_client : bool ref = ref false

(** Scope stacks — dynamic scope for render-time effects.
    Each key maps to a stack of values. Used by aser for
    spread/provide/emit patterns, CSSX collect/flush, etc.
    Migrated from sx_scope.ml. *)
let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8

(** Debug trace for scope operations *)
let _scope_trace = ref false
let _scope_log : string list ref = ref []
let scope_trace_enable () = _scope_trace := true; _scope_log := []
let scope_trace_disable () = _scope_trace := false
let scope_trace_drain () =
  let log = List.rev !_scope_log in
  _scope_log := [];
  log

(** Request cookies — set by the Python bridge before each render.
    get-cookie reads from here; set-cookie is a no-op on the server. *)
let _request_cookies : (string, string) Hashtbl.t = Hashtbl.create 8

(** Clear all scope stacks. Called between requests if needed. *)
let scope_clear_all () = Hashtbl.clear _scope_stacks

let register name fn = Hashtbl.replace primitives name fn

let is_primitive name = Hashtbl.mem primitives name

let get_primitive name =
  match Hashtbl.find_opt primitives name with
  | Some fn -> NativeFn (name, fn)
  | None -> raise (Eval_error ("Unknown primitive: " ^ name))

(* --- Helpers --- *)

(* Trampoline hook — set by sx_ref after initialization to break circular dep *)
let trampoline_hook : (value -> value) ref = ref (fun v -> v)

let as_int = function
  | Integer n -> n
  | Number n -> int_of_float n
  | v -> raise (Eval_error ("Expected number, got " ^ type_of v))

let all_ints = List.for_all (function Integer _ -> true | _ -> false)

let rec as_number = function
  | Integer n -> float_of_int n
  | Number n -> n
  | Rational(n, d) -> float_of_int n /. float_of_int d
  | Bool true -> 1.0
  | Bool false -> 0.0
  | Nil -> 0.0
  | String s -> (match float_of_string_opt s with Some n -> n | None -> Float.nan)
  | Thunk _ as t ->
    (* Trampoline thunks — they shouldn't leak but sometimes do *)
    as_number (!trampoline_hook t)
  | v -> raise (Eval_error ("Expected number, got " ^ type_of v ^ ": " ^ (match v with Dict d -> (match Hashtbl.find_opt d "__signal" with Some _ -> "signal{value=" ^ (match Hashtbl.find_opt d "value" with Some v' -> value_to_string v' | None -> "?") ^ "}" | None -> "dict") | _ -> "")))

let as_string = function
  | String s -> s
  | v -> raise (Eval_error ("Expected string, got " ^ type_of v))

let rec as_list = function
  | List l -> l
  | ListRef r -> !r
  | Nil -> []
  | Thunk _ as t -> as_list (!_sx_trampoline_fn t)
  | v -> raise (Eval_error ("Expected list, got " ^ type_of v))

let as_bool = function
  | Bool b -> b
  | v -> sx_truthy v

let rec to_string = function
  | String s -> s
  | Integer n -> string_of_int n
  | Number n -> Sx_types.format_number n
  | Bool true -> "true"
  | Bool false -> "false"
  | Nil -> ""
  | Symbol s -> s
  | Keyword k -> k
  | Thunk _ as t -> to_string (!trampoline_hook t)
  | SxExpr s -> s
  | RawHTML s -> s
  | v -> inspect v

let gensym_counter = ref 0

let rat_gcd a b =
  let rec g a b = if b = 0 then a else g b (a mod b) in g (abs a) (abs b)

let make_rat n d =
  if d = 0 then raise (Eval_error "rational: division by zero");
  let sign = if d < 0 then -1 else 1 in
  let g = rat_gcd (abs n) (abs d) in
  let rn = sign * n / g and rd = sign * d / g in
  if rd = 1 then Integer rn else Rational (rn, rd)

let rat_of_val = function
  | Integer n     -> (n, 1)
  | Rational(n,d) -> (n, d)
  | v -> raise (Eval_error ("expected integer or rational, got " ^ type_of v))

let has_rational args = List.exists (function Rational _ -> true | _ -> false) args
let has_float    args = List.exists (function Number  _ -> true | _ -> false) args

let rat_add (an, ad) (bn, bd) = make_rat (an * bd + bn * ad) (ad * bd)
let rat_sub (an, ad) (bn, bd) = make_rat (an * bd - bn * ad) (ad * bd)
let rat_mul (an, ad) (bn, bd) = make_rat (an * bn) (ad * bd)
let rat_div (an, ad) (bn, bd) =
  if bn = 0 then raise (Eval_error "rational: division by zero");
  make_rat (an * bd) (ad * bn)

(* write/display serializers *)
let rec sx_write_val = function
  | Nil -> "()"
  | Eof -> "#!eof"
  | Bool true -> "#t"
  | Bool false -> "#f"
  | Integer n -> string_of_int n
  | Number n ->
    let s = Printf.sprintf "%g" n in
    (* Ensure float-like if no decimal point *)
    if String.contains s '.' || String.contains s 'e' then s else s
  | Rational(n, d) -> Printf.sprintf "%d/%d" n d
  | String s ->
    let buf = Buffer.create (String.length s + 2) in
    Buffer.add_char buf '"';
    String.iter (function
      | '"'  -> Buffer.add_string buf "\\\""
      | '\\' -> Buffer.add_string buf "\\\\"
      | '\n' -> Buffer.add_string buf "\\n"
      | '\r' -> Buffer.add_string buf "\\r"
      | '\t' -> Buffer.add_string buf "\\t"
      | c    -> Buffer.add_char buf c) s;
    Buffer.add_char buf '"';
    Buffer.contents buf
  | Char n ->
    if n = 32 then "#\\space"
    else if n = 10 then "#\\newline"
    else if n = 9 then "#\\tab"
    else Printf.sprintf "#\\%c" (Char.chr (n land 0xFF))
  | Symbol s -> s
  | Keyword k -> ":" ^ k
  | List items | ListRef { contents = items } ->
    "(" ^ String.concat " " (List.map sx_write_val items) ^ ")"
  | v -> inspect v

and sx_display_val = function
  | String s -> s
  | Char n -> String.make 1 (Char.chr (n land 0xFF))
  | v -> sx_write_val v

let () =
  (* === Arithmetic === *)
  register "+" (fun args ->
    if all_ints args then
      Integer (List.fold_left (fun acc a -> match a with Integer n -> acc + n | _ -> acc) 0 args)
    else if has_rational args && not (has_float args) then
      List.fold_left (fun acc a ->
        match acc, a with
        | Integer an, _ -> rat_add (an, 1) (rat_of_val a)
        | Rational(an,ad), _ -> rat_add (an, ad) (rat_of_val a)
        | _ -> acc
      ) (Integer 0) args
    else
      Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args));
  register "-" (fun args ->
    match args with
    | [] -> Integer 0
    | [Integer n] -> Integer (-n)
    | [Rational(n,d)] -> make_rat (-n) d
    | [a] -> Number (-. (as_number a))
    | _ when all_ints args ->
      (match args with
       | Integer h :: tl ->
         Integer (List.fold_left (fun acc a -> match a with Integer n -> acc - n | _ -> acc) h tl)
       | _ -> Number 0.0)
    | _ when has_rational args && not (has_float args) ->
      (match args with
       | h :: tl ->
         List.fold_left (fun acc a ->
           match acc with
           | Integer an -> rat_sub (an, 1) (rat_of_val a)
           | Rational(an,ad) -> rat_sub (an, ad) (rat_of_val a)
           | _ -> acc
         ) h tl
       | _ -> Integer 0)
    | a :: rest ->
      Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest));
  register "*" (fun args ->
    if all_ints args then
      Integer (List.fold_left (fun acc a -> match a with Integer n -> acc * n | _ -> acc) 1 args)
    else if has_rational args && not (has_float args) then
      List.fold_left (fun acc a ->
        match acc with
        | Integer an -> rat_mul (an, 1) (rat_of_val a)
        | Rational(an,ad) -> rat_mul (an, ad) (rat_of_val a)
        | _ -> acc
      ) (Integer 1) args
    else
      Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
  register "/" (fun args ->
    match args with
    | [Integer a; Integer b] -> make_rat a b
    | [Rational(an,ad); Integer b] -> make_rat an (ad * b)
    | [Integer a; Rational(bn,bd)] -> make_rat (a * bd) bn
    | [Rational(an,ad); Rational(bn,bd)] -> rat_div (an, ad) (bn, bd)
    | [a; b] -> Number (as_number a /. as_number b)
    | _ -> raise (Eval_error "/: expected 2 args"));
  register "mod" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (a mod b)
    | [a; b] -> Number (Float.rem (as_number a) (as_number b))
    | _ -> raise (Eval_error "mod: expected 2 args"));
  register "inc" (fun args ->
    match args with
    | [Integer n] -> Integer (n + 1)
    | [a] -> Number (as_number a +. 1.0)
    | _ -> raise (Eval_error "inc: 1 arg"));
  register "dec" (fun args ->
    match args with
    | [Integer n] -> Integer (n - 1)
    | [a] -> Number (as_number a -. 1.0)
    | _ -> raise (Eval_error "dec: 1 arg"));
  register "abs" (fun args ->
    match args with
    | [Integer n] -> Integer (abs n)
    | [a] -> Number (Float.abs (as_number a))
    | _ -> raise (Eval_error "abs: 1 arg"));
  register "floor" (fun args ->
    match args with
    | [Integer n] -> Integer n
    | [a] -> Integer (int_of_float (floor (as_number a)))
    | _ -> raise (Eval_error "floor: 1 arg"));
  register "ceil" (fun args ->
    match args with
    | [Integer n] -> Integer n
    | [a] -> Integer (int_of_float (ceil (as_number a)))
    | _ -> raise (Eval_error "ceil: 1 arg"));
  register "round" (fun args ->
    match args with
    | [Integer n] -> Integer n
    | [a] -> Integer (int_of_float (Float.round (as_number a)))
    | [a; b] ->
      let n = as_number a and places = as_int b in
      let factor = 10.0 ** float_of_int places in
      Number (Float.round (n *. factor) /. factor)
    | _ -> raise (Eval_error "round: 1-2 args"));
  register "min" (fun args ->
    match args with
    | [] -> raise (Eval_error "min: at least 1 arg")
    | _ when all_ints args ->
      Integer (List.fold_left (fun acc a -> match a with Integer n -> min acc n | _ -> acc) max_int args)
    | _ -> Number (List.fold_left (fun acc a -> Float.min acc (as_number a)) Float.infinity args));
  register "max" (fun args ->
    match args with
    | [] -> raise (Eval_error "max: at least 1 arg")
    | _ when all_ints args ->
      Integer (List.fold_left (fun acc a -> match a with Integer n -> max acc n | _ -> acc) min_int args)
    | _ -> Number (List.fold_left (fun acc a -> Float.max acc (as_number a)) Float.neg_infinity args));
  register "sqrt" (fun args ->
    match args with [a] -> Number (Float.sqrt (as_number a)) | _ -> raise (Eval_error "sqrt: 1 arg"));
  register "pow" (fun args ->
    match args with [a; b] -> Number (as_number a ** as_number b)
    | _ -> raise (Eval_error "pow: 2 args"));
  register "cbrt" (fun args ->
    match args with [a] -> Number (Float.cbrt (as_number a)) | _ -> raise (Eval_error "cbrt: 1 arg"));
  register "exp" (fun args ->
    match args with [a] -> Number (Float.exp (as_number a)) | _ -> raise (Eval_error "exp: 1 arg"));
  register "expm1" (fun args ->
    match args with [a] -> Number (Float.expm1 (as_number a)) | _ -> raise (Eval_error "expm1: 1 arg"));
  register "log" (fun args ->
    match args with [a] -> Number (Float.log (as_number a)) | _ -> raise (Eval_error "log: 1 arg"));
  register "log2" (fun args ->
    match args with [a] -> Number (Float.log (as_number a) /. Float.log 2.0) | _ -> raise (Eval_error "log2: 1 arg"));
  register "log10" (fun args ->
    match args with [a] -> Number (Float.log10 (as_number a)) | _ -> raise (Eval_error "log10: 1 arg"));
  register "log1p" (fun args ->
    match args with [a] -> Number (Float.log1p (as_number a)) | _ -> raise (Eval_error "log1p: 1 arg"));
  register "sin" (fun args ->
    match args with [a] -> Number (Float.sin (as_number a)) | _ -> raise (Eval_error "sin: 1 arg"));
  register "cos" (fun args ->
    match args with [a] -> Number (Float.cos (as_number a)) | _ -> raise (Eval_error "cos: 1 arg"));
  register "tan" (fun args ->
    match args with [a] -> Number (Float.tan (as_number a)) | _ -> raise (Eval_error "tan: 1 arg"));
  register "asin" (fun args ->
    match args with [a] -> Number (Float.asin (as_number a)) | _ -> raise (Eval_error "asin: 1 arg"));
  register "acos" (fun args ->
    match args with [a] -> Number (Float.acos (as_number a)) | _ -> raise (Eval_error "acos: 1 arg"));
  register "atan" (fun args ->
    match args with
    | [a] -> Number (Float.atan (as_number a))
    | [y; x] -> Number (Float.atan2 (as_number y) (as_number x))
    | _ -> raise (Eval_error "atan: 1-2 args"));
  register "atan2" (fun args ->
    match args with [a; b] -> Number (Float.atan2 (as_number a) (as_number b))
    | _ -> raise (Eval_error "atan2: 2 args"));
  register "sinh" (fun args ->
    match args with [a] -> Number (Float.sinh (as_number a)) | _ -> raise (Eval_error "sinh: 1 arg"));
  register "cosh" (fun args ->
    match args with [a] -> Number (Float.cosh (as_number a)) | _ -> raise (Eval_error "cosh: 1 arg"));
  register "tanh" (fun args ->
    match args with [a] -> Number (Float.tanh (as_number a)) | _ -> raise (Eval_error "tanh: 1 arg"));
  register "asinh" (fun args ->
    match args with [a] -> Number (Float.asinh (as_number a)) | _ -> raise (Eval_error "asinh: 1 arg"));
  register "acosh" (fun args ->
    match args with [a] -> Number (Float.acosh (as_number a)) | _ -> raise (Eval_error "acosh: 1 arg"));
  register "atanh" (fun args ->
    match args with [a] -> Number (Float.atanh (as_number a)) | _ -> raise (Eval_error "atanh: 1 arg"));
  register "hypot" (fun args ->
    let square x = x *. x in
    let sum = List.fold_left (fun acc a -> acc +. square (as_number a)) 0.0 args in
    Number (Float.sqrt sum));
  register "sign" (fun args ->
    match args with
    | [Integer n] -> Integer (if n > 0 then 1 else if n < 0 then -1 else 0)
    | [a] ->
      let n = as_number a in
      Number (if Float.is_nan n then Float.nan
              else if n > 0.0 then 1.0
              else if n < 0.0 then -1.0
              else n)
    | _ -> raise (Eval_error "sign: 1 arg"));
  register "fround" (fun args ->
    match args with [a] -> Number (Int32.float_of_bits (Int32.bits_of_float (as_number a)))
    | _ -> raise (Eval_error "fround: 1 arg"));
  register "clz32" (fun args ->
    match args with
    | [a] ->
      let n = as_number a in
      let i = if Float.is_nan n || Float.is_infinite n then 0l
              else Int32.of_float (Float.rem n 4294967296.0) in
      if i = 0l then Number 32.0
      else
        let high_bit = Int32.shift_left 1l 31 in
        let count = ref 0 in
        let x = ref i in
        while Int32.logand !x high_bit = 0l do
          incr count;
          x := Int32.shift_left !x 1
        done;
        Number (float_of_int !count)
    | _ -> raise (Eval_error "clz32: 1 arg"));
  register "imul" (fun args ->
    match args with
    | [a; b] ->
      let tou32 f =
        if Float.is_nan f || Float.is_infinite f then 0l
        else Int32.of_float (Float.rem f 4294967296.0) in
      let ai = tou32 (as_number a) and bi = tou32 (as_number b) in
      let r = Int32.mul ai bi in
      Number (Int32.to_float r)
    | _ -> raise (Eval_error "imul: 2 args"));
  register "clamp" (fun args ->
    match args with
    | [x; lo; hi] ->
      let x = as_number x and lo = as_number lo and hi = as_number hi in
      Number (Float.max lo (Float.min hi x))
    | _ -> raise (Eval_error "clamp: 3 args"));
  register "truncate" (fun args ->
    match args with
    | [Integer n] -> Integer n
    | [a] -> let n = as_number a in Integer (int_of_float (if n >= 0.0 then floor n else ceil n))
    | _ -> raise (Eval_error "truncate: 1 arg"));
  register "remainder" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (a mod b)
    | [a; b] -> Number (Float.rem (as_number a) (as_number b))
    | _ -> raise (Eval_error "remainder: 2 args"));
  register "modulo" (fun args ->
    match args with
    | [Integer a; Integer b] ->
      let r = a mod b in
      Integer (if r = 0 || (r > 0) = (b > 0) then r else r + b)
    | [a; b] ->
      let a = as_number a and b = as_number b in
      let r = Float.rem a b in
      Number (if r = 0.0 || (r > 0.0) = (b > 0.0) then r else r +. b)
    | _ -> raise (Eval_error "modulo: 2 args"));
  register "exact?" (fun args ->
    match args with
    | [Integer _] -> Bool true
    | [Number _] -> Bool false
    | [_] -> Bool false
    | _ -> raise (Eval_error "exact?: 1 arg"));
  register "inexact?" (fun args ->
    match args with
    | [Number _] -> Bool true
    | [Integer _] -> Bool false
    | [_] -> Bool false
    | _ -> raise (Eval_error "inexact?: 1 arg"));
  register "exact->inexact" (fun args ->
    match args with
    | [Integer n] -> Number (float_of_int n)
    | [Number n] -> Number n
    | [Rational(n,d)] -> Number (float_of_int n /. float_of_int d)
    | [a] -> Number (as_number a)
    | _ -> raise (Eval_error "exact->inexact: 1 arg"));
  register "inexact->exact" (fun args ->
    match args with
    | [Integer n] -> Integer n
    | [Number n] -> Integer (int_of_float (Float.round n))
    | [a] -> Integer (int_of_float (Float.round (as_number a)))
    | _ -> raise (Eval_error "inexact->exact: 1 arg"));
  register "expt" (fun args ->
    match args with
    | [Integer a; Integer b] when b >= 0 ->
      let rec ipow base e acc = if e = 0 then acc else ipow base (e - 1) (acc * base) in
      Integer (ipow a b 1)
    | [a; b] -> Number (Float.pow (as_number a) (as_number b))
    | _ -> raise (Eval_error "expt: 2 args"));
  register "quotient" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (Int.div a b)
    | [a; b] ->
      let n = as_number a /. as_number b in
      Integer (int_of_float (if n >= 0.0 then floor n else ceil n))
    | _ -> raise (Eval_error "quotient: 2 args"));
  let rec igcd a b = if b = 0 then a else igcd b (a mod b) in
  register "gcd" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (igcd (abs a) (abs b))
    | [a; b] ->
      let rec fgcd a b = if b = 0.0 then a else fgcd b (Float.rem a b) in
      Number (fgcd (abs_float (as_number a)) (abs_float (as_number b)))
    | _ -> raise (Eval_error "gcd: 2 args"));
  register "lcm" (fun args ->
    match args with
    | [Integer a; Integer b] ->
      let g = igcd (abs a) (abs b) in
      if g = 0 then Integer 0 else Integer (abs a / g * abs b)
    | [a; b] ->
      let a = abs_float (as_number a) and b = abs_float (as_number b) in
      let rec fgcd a b = if b = 0.0 then a else fgcd b (Float.rem a b) in
      let g = fgcd a b in
      if g = 0.0 then Number 0.0 else Number (a /. g *. b)
    | _ -> raise (Eval_error "lcm: 2 args"));
  register "number->string" (fun args ->
    let digits = "0123456789abcdefghijklmnopqrstuvwxyz" in
    let int_to_radix n r =
      if n = 0 then "0"
      else begin
        let neg = n < 0 in
        let buf = Buffer.create 16 in
        let rec go n = if n > 0 then begin go (n / r); Buffer.add_char buf digits.[n mod r] end in
        go (abs n);
        (if neg then "-" else "") ^ Buffer.contents buf
      end
    in
    match args with
    | [Integer n] -> String (string_of_int n)
    | [Number f] -> String (Printf.sprintf "%g" f)
    | [Rational(n,d)] -> String (Printf.sprintf "%d/%d" n d)
    | [Integer n; Integer r] ->
      if r < 2 || r > 36 then raise (Eval_error "number->string: radix out of range");
      String (int_to_radix n r)
    | [Number f; Integer r] ->
      if r < 2 || r > 36 then raise (Eval_error "number->string: radix out of range");
      String (int_to_radix (int_of_float f) r)
    | _ -> raise (Eval_error "number->string: 1-2 args"));
  register "string->number" (fun args ->
    match args with
    | [String s] ->
      (try Integer (int_of_string s)
       with _ -> try Number (float_of_string s)
       with _ -> Nil)
    | [String s; Integer r] ->
      (try
        let neg = String.length s > 0 && s.[0] = '-' in
        let start = if neg then 1 else 0 in
        let n = ref 0 in
        for i = start to String.length s - 1 do
          let c = Char.code s.[i] in
          let d = if c >= 48 && c <= 57 then c - 48
                  else if c >= 97 && c <= 122 then c - 87
                  else if c >= 65 && c <= 90  then c - 55
                  else raise Exit
          in
          if d >= r then raise Exit;
          n := !n * r + d
        done;
        Integer (if neg then - !n else !n)
       with _ -> Nil)
    | _ -> raise (Eval_error "string->number: 1-2 args"));
  let make_rational_val n d =
    if d = 0 then raise (Eval_error "make-rational: denominator cannot be zero");
    let rec gcd a b = if b = 0 then a else gcd b (a mod b) in
    let sign = if d < 0 then -1 else 1 in
    let g = gcd (abs n) (abs d) in
    let rn = sign * n / g and rd = sign * d / g in
    if rd = 1 then Integer rn else Rational (rn, rd)
  in
  register "make-rational" (fun args ->
    match args with
    | [Integer n; Integer d] -> make_rational_val n d
    | [Number f; Integer d]  -> make_rational_val (int_of_float f) d
    | [Integer n; Number f]  -> make_rational_val n (int_of_float f)
    | _ -> raise (Eval_error "make-rational: expected 2 integers"));
  register "rational?" (fun args ->
    match args with
    | [Rational _] -> Bool true
    | [_]          -> Bool false
    | _ -> raise (Eval_error "rational?: expected 1 arg"));
  register "numerator" (fun args ->
    match args with
    | [Rational (n, _)] -> Integer n
    | [Integer n]       -> Integer n
    | _ -> raise (Eval_error "numerator: expected rational or integer"));
  register "denominator" (fun args ->
    match args with
    | [Rational (_, d)] -> Integer d
    | [Integer _]       -> Integer 1
    | _ -> raise (Eval_error "denominator: expected rational or integer"));
  (* printf-spec: apply one Tcl/printf format spec to one arg.
     spec is like "%5.2f", "%-10s", "%x", "%c", "%d". Always starts with %
     and ends with the conversion char.  Supports d i u x X o c s f e g.
     Coerces arg to the right type per conversion. *)
  register "printf-spec" (fun args ->
    let spec_str, arg = match args with
      | [String s; v] -> (s, v)
      | _ -> raise (Eval_error "printf-spec: (spec arg)")
    in
    let n = String.length spec_str in
    if n < 2 || spec_str.[0] <> '%' then
      raise (Eval_error ("printf-spec: invalid spec " ^ spec_str));
    let type_char = spec_str.[n - 1] in
    let to_int v = match v with
      | Integer i -> i
      | Number f -> int_of_float f
      | String s ->
        let s = String.trim s in
        (try int_of_string s
         with _ ->
           try int_of_float (float_of_string s)
           with _ -> 0)
      | Bool true -> 1 | Bool false -> 0
      | _ -> 0
    in
    let to_float v = match v with
      | Number f -> f
      | Integer i -> float_of_int i
      | String s ->
        let s = String.trim s in
        (try float_of_string s with _ -> 0.0)
      | _ -> 0.0
    in
    let to_string v = match v with
      | String s -> s
      | Integer i -> string_of_int i
      | Number f -> Sx_types.format_number f
      | Bool true -> "1" | Bool false -> "0"
      | Nil -> ""
      | _ -> Sx_types.inspect v
    in
    try
      match type_char with
      | 'd' | 'i' ->
        let fmt = Scanf.format_from_string spec_str "%d" in
        String (Printf.sprintf fmt (to_int arg))
      | 'u' ->
        let fmt = Scanf.format_from_string spec_str "%u" in
        String (Printf.sprintf fmt (to_int arg))
      | 'x' ->
        let fmt = Scanf.format_from_string spec_str "%x" in
        String (Printf.sprintf fmt (to_int arg))
      | 'X' ->
        let fmt = Scanf.format_from_string spec_str "%X" in
        String (Printf.sprintf fmt (to_int arg))
      | 'o' ->
        let fmt = Scanf.format_from_string spec_str "%o" in
        String (Printf.sprintf fmt (to_int arg))
      | 'c' ->
        let n_val = to_int arg in
        let body = String.sub spec_str 0 (n - 1) in
        let fmt = Scanf.format_from_string (body ^ "s") "%s" in
        String (Printf.sprintf fmt (String.make 1 (Char.chr (n_val land 0xff))))
      | 's' ->
        let fmt = Scanf.format_from_string spec_str "%s" in
        String (Printf.sprintf fmt (to_string arg))
      | 'f' ->
        let fmt = Scanf.format_from_string spec_str "%f" in
        String (Printf.sprintf fmt (to_float arg))
      | 'e' ->
        let fmt = Scanf.format_from_string spec_str "%e" in
        String (Printf.sprintf fmt (to_float arg))
      | 'E' ->
        let fmt = Scanf.format_from_string spec_str "%E" in
        String (Printf.sprintf fmt (to_float arg))
      | 'g' ->
        let fmt = Scanf.format_from_string spec_str "%g" in
        String (Printf.sprintf fmt (to_float arg))
      | 'G' ->
        let fmt = Scanf.format_from_string spec_str "%G" in
        String (Printf.sprintf fmt (to_float arg))
      | _ -> raise (Eval_error ("printf-spec: unsupported conversion " ^ String.make 1 type_char))
    with
    | Eval_error _ as e -> raise e
    | _ -> raise (Eval_error ("printf-spec: invalid format " ^ spec_str)));

  (* scan-spec: apply one Tcl/scanf format spec to a string.
     Returns (consumed-count . parsed-value), or nil on failure. *)
  register "scan-spec" (fun args ->
    let spec_str, str = match args with
      | [String s; String input] -> (s, input)
      | _ -> raise (Eval_error "scan-spec: (spec input)")
    in
    let n = String.length spec_str in
    if n < 2 || spec_str.[0] <> '%' then
      raise (Eval_error ("scan-spec: invalid spec " ^ spec_str));
    let type_char = spec_str.[n - 1] in
    let len = String.length str in
    (* skip leading whitespace for non-%c/%s conversions *)
    let i = ref 0 in
    if type_char <> 'c' then
      while !i < len && (str.[!i] = ' ' || str.[!i] = '\t' || str.[!i] = '\n') do incr i done;
    let start = !i in
    try
      match type_char with
      | 'd' | 'i' ->
        let j = ref !i in
        if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
        while !j < len && str.[!j] >= '0' && str.[!j] <= '9' do incr j done;
        if !j > start && (str.[start] >= '0' && str.[start] <= '9'
                         || (!j > start + 1 && (str.[start] = '-' || str.[start] = '+'))) then
          let n_val = int_of_string (String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer n_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'x' | 'X' ->
        let j = ref !i in
        while !j < len &&
              ((str.[!j] >= '0' && str.[!j] <= '9') ||
               (str.[!j] >= 'a' && str.[!j] <= 'f') ||
               (str.[!j] >= 'A' && str.[!j] <= 'F')) do incr j done;
        if !j > start then
          let n_val = int_of_string ("0x" ^ String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer n_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'o' ->
        let j = ref !i in
        while !j < len && str.[!j] >= '0' && str.[!j] <= '7' do incr j done;
        if !j > start then
          let n_val = int_of_string ("0o" ^ String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer n_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'f' | 'e' | 'g' ->
        let j = ref !i in
        if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
        while !j < len && ((str.[!j] >= '0' && str.[!j] <= '9') || str.[!j] = '.') do incr j done;
        if !j < len && (str.[!j] = 'e' || str.[!j] = 'E') then begin
          incr j;
          if !j < len && (str.[!j] = '-' || str.[!j] = '+') then incr j;
          while !j < len && str.[!j] >= '0' && str.[!j] <= '9' do incr j done
        end;
        if !j > start then
          let f_val = float_of_string (String.sub str start (!j - start)) in
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Number f_val);
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 's' ->
        let j = ref !i in
        while !j < len && str.[!j] <> ' ' && str.[!j] <> '\t' && str.[!j] <> '\n' do incr j done;
        if !j > start then
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (String (String.sub str start (!j - start)));
          Hashtbl.replace d "consumed" (Integer !j);
          Dict d
        else Nil
      | 'c' ->
        if !i < len then
          let d = Hashtbl.create 2 in
          Hashtbl.replace d "value" (Integer (Char.code str.[!i]));
          Hashtbl.replace d "consumed" (Integer (!i + 1));
          Dict d
        else Nil
      | _ -> raise (Eval_error ("scan-spec: unsupported conversion " ^ String.make 1 type_char))
    with
    | Eval_error _ as e -> raise e
    | _ -> Nil);

  register "parse-int" (fun args ->
    let parse_leading_int s =
      let len = String.length s in
      let start = ref 0 in
      let neg = len > 0 && s.[0] = '-' in
      if neg then start := 1
      else if len > 0 && s.[0] = '+' then start := 1;
      let j = ref !start in
      while !j < len && s.[!j] >= '0' && s.[!j] <= '9' do incr j done;
      if !j > !start then
        let n = int_of_string (String.sub s !start (!j - !start)) in
        Some (if neg then -n else n)
      else None
    in
    match args with
    | [String s] -> (match parse_leading_int s with Some n -> Integer n | None -> Nil)
    | [String s; default_val] ->
      (match parse_leading_int s with Some n -> Integer n | None -> default_val)
    | [Integer n] | [Integer n; _] -> Integer n
    | [Number n] | [Number n; _] -> Integer (int_of_float n)
    | [_; default_val] -> default_val
    | _ -> Nil);
  register "parse-float" (fun args ->
    match args with
    | [String s] -> (match float_of_string_opt s with Some n -> Number n | None -> Nil)
    | [Number n] -> Number n
    | _ -> Nil);

  (* === Comparison === *)
  (* Safe equality: physical equality for potentially-circular types
     (Dict, Lambda, Component, Island, Signal, NativeFn),
     structural equality for acyclic types (Number, String, Bool, etc.).
     Lists are compared element-wise recursively with the same safety. *)
  let rec safe_eq a b =
    if a == b then true  (* physical equality fast path *)
    else match a, b with
    | 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
    | Rational(n, d), Number y -> float_of_int n /. float_of_int d = y
    | Number x, Rational(n, d) -> x = float_of_int n /. float_of_int d
    | Rational(an, ad), Rational(bn, bd) -> an * bd = bn * ad
    | Rational(n, d), Integer y -> n = y * d
    | Integer x, Rational(n, d) -> x * d = n
    | String x, String y -> x = y
    | Bool x, Bool y -> x = y
    | Nil, Nil -> true
    | Symbol x, Symbol y -> x = y
    | Keyword x, Keyword y -> x = y
    | (List la | ListRef { contents = la }),
      (List lb | ListRef { contents = lb }) ->
      List.length la = List.length lb &&
      List.for_all2 safe_eq la lb
    (* Dict: __host_handle identity for DOM-wrapped dicts; otherwise
       structural equality over keys + values. *)
    | Dict a, Dict b ->
      (match Hashtbl.find_opt a "__host_handle", Hashtbl.find_opt b "__host_handle" with
       | Some (Number ha), Some (Number hb) -> ha = hb
       | Some _, _ | _, Some _ -> false
       | None, None ->
         Hashtbl.length a = Hashtbl.length b &&
         (let eq = ref true in
          Hashtbl.iter (fun k v ->
            if !eq then
              match Hashtbl.find_opt b k with
              | Some v' -> if not (safe_eq v v') then eq := false
              | None -> eq := false
          ) a;
          !eq))
    (* Records: same type + structurally equal fields *)
    | Record a, Record b ->
      a.r_type.rt_uid = b.r_type.rt_uid &&
      Array.length a.r_fields = Array.length b.r_fields &&
      (let eq = ref true in
       for i = 0 to Array.length a.r_fields - 1 do
         if not (safe_eq a.r_fields.(i) b.r_fields.(i)) then eq := false
       done; !eq)
    (* Parameters: same UID = same parameter *)
    | Parameter a, Parameter b -> a.pm_uid = b.pm_uid
    (* Vectors: same length + element-wise equal *)
    | Vector a, Vector b ->
      Array.length a = Array.length b &&
      (let eq = ref true in
       for i = 0 to Array.length a - 1 do
         if not (safe_eq a.(i) b.(i)) then eq := false
       done; !eq)
    (* Lambda/Component/Island/Signal/NativeFn: physical only *)
    | _ -> false
  in
  register "=" (fun args ->
    match args with
    | [a; b] -> Bool (safe_eq a b)
    | _ -> raise (Eval_error "=: 2 args"));
  register "!=" (fun args ->
    match args with
    | [a; b] -> Bool (not (safe_eq a b))
    | _ -> raise (Eval_error "!=: 2 args"));
  register "<" (fun args ->
    match args with
    | [String a; String b] -> Bool (a < b)
    | [a; b] -> Bool (as_number a < as_number b)
    | _ -> raise (Eval_error "<: 2 args"));
  register ">" (fun args ->
    match args with
    | [String a; String b] -> Bool (a > b)
    | [a; b] -> Bool (as_number a > as_number b)
    | _ -> raise (Eval_error ">: 2 args"));
  register "<=" (fun args ->
    match args with
    | [String a; String b] -> Bool (a <= b)
    | [a; b] -> Bool (as_number a <= as_number b)
    | _ -> raise (Eval_error "<=: 2 args"));
  register ">=" (fun args ->
    match args with
    | [String a; String b] -> Bool (a >= b)
    | [a; b] -> Bool (as_number a >= as_number b)
    | _ -> raise (Eval_error ">=: 2 args"));

  (* === Logic === *)
  register "not" (fun args ->
    match args with [a] -> Bool (not (sx_truthy a)) | _ -> raise (Eval_error "not: 1 arg"));

  (* === Predicates === *)
  register "nil?" (fun args ->
    match args with [a] -> Bool (is_nil a) | _ -> raise (Eval_error "nil?: 1 arg"));
  register "number?" (fun args ->
    match args with
    | [Integer _] | [Number _] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "number?: 1 arg"));
  register "integer?" (fun args ->
    match args with
    | [Integer _] -> Bool true
    | [Number f] -> Bool (Float.is_integer f)
    | [_] -> Bool false
    | _ -> raise (Eval_error "integer?: 1 arg"));
  register "float?" (fun args ->
    match args with
    | [Number _] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "float?: 1 arg"));
  register "string?" (fun args ->
    match args with [String _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "string?: 1 arg"));
  register "boolean?" (fun args ->
    match args with [Bool _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "boolean?: 1 arg"));
  register "list?" (fun args ->
    match args with [List _] | [ListRef _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "list?: 1 arg"));
  register "dict?" (fun args ->
    match args with [Dict _] -> Bool true | [AdtValue _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "dict?: 1 arg"));
  register "adt?" (fun args ->
    match args with [AdtValue _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "adt?: 1 arg"));
  register "symbol?" (fun args ->
    match args with [Symbol _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "symbol?: 1 arg"));
  register "keyword?" (fun args ->
    match args with [Keyword _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "keyword?: 1 arg"));
  register "empty?" (fun args ->
    match args with
    | [List []] | [ListRef { contents = [] }] -> Bool true
    | [List _] | [ListRef _] -> Bool false
    | [String ""] -> Bool true | [String _] -> Bool false
    | [Dict d] -> Bool (Hashtbl.length d = 0)
    | [Nil] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "empty?: 1 arg"));
  register "odd?" (fun args ->
    match args with [a] -> Bool (int_of_float (as_number a) mod 2 <> 0) | _ -> raise (Eval_error "odd?: 1 arg"));
  register "even?" (fun args ->
    match args with [a] -> Bool (int_of_float (as_number a) mod 2 = 0) | _ -> raise (Eval_error "even?: 1 arg"));
  register "zero?" (fun args ->
    match args with [a] -> Bool (as_number a = 0.0) | _ -> raise (Eval_error "zero?: 1 arg"));

  (* === Strings === *)
  register "str" (fun args -> String (String.concat "" (List.map to_string args)));
  register "upper" (fun args ->
    match args with [a] -> String (String.uppercase_ascii (as_string a)) | _ -> raise (Eval_error "upper: 1 arg"));
  register "upcase" (fun args ->
    match args with [a] -> String (String.uppercase_ascii (as_string a)) | _ -> raise (Eval_error "upcase: 1 arg"));
  register "lower" (fun args ->
    match args with [a] -> String (String.lowercase_ascii (as_string a)) | _ -> raise (Eval_error "lower: 1 arg"));
  register "downcase" (fun args ->
    match args with [a] -> String (String.lowercase_ascii (as_string a)) | _ -> raise (Eval_error "downcase: 1 arg"));
  register "trim" (fun args ->
    match args with [a] -> String (String.trim (as_string a)) | _ -> raise (Eval_error "trim: 1 arg"));
  register "string-length" (fun args ->
    match args with [a] -> Integer (String.length (as_string a))
    | _ -> raise (Eval_error "string-length: 1 arg"));
  register "string-contains?" (fun args ->
    match args with
    | [String haystack; String needle] ->
      let rec find i =
        if i + String.length needle > String.length haystack then false
        else if String.sub haystack i (String.length needle) = needle then true
        else find (i + 1)
      in Bool (find 0)
    | _ -> raise (Eval_error "string-contains?: 2 string args"));
  register "starts-with?" (fun args ->
    match args with
    | [String s; String prefix] ->
      Bool (String.length s >= String.length prefix &&
            String.sub s 0 (String.length prefix) = prefix)
    | _ -> Bool false);
  register "ends-with?" (fun args ->
    match args with
    | [String s; String suffix] ->
      let sl = String.length s and xl = String.length suffix in
      Bool (sl >= xl && String.sub s (sl - xl) xl = suffix)
    | _ -> Bool false);
  register "index-of" (fun args ->
    match args with
    | [String haystack; String needle] ->
      let nl = String.length needle and hl = String.length haystack in
      let rec find i =
        if i + nl > hl then Number (-1.0)
        else if String.sub haystack i nl = needle then Number (float_of_int i)
        else find (i + 1)
      in find 0
    | [List items; target] | [ListRef { contents = items }; target] ->
      let eq a b = match a, b with
        | 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
        | String x, String y -> x = y
        | Symbol x, Symbol y -> x = y | Keyword x, Keyword y -> x = y
        | Bool x, Bool y -> x = y | Nil, Nil -> true | _ -> a == b in
      let rec find i = function
        | [] -> Nil
        | h :: _ when eq h target -> Number (float_of_int i)
        | _ :: tl -> find (i + 1) tl
      in find 0 items
    | _ -> raise (Eval_error "index-of: 2 string args or list+target"));
  register "substring" (fun args ->
    match args with
    | [String s; start_v; end_v] ->
      let i = as_int start_v and j = as_int end_v in
      let len = String.length s in
      let i = max 0 (min i len) and j = max 0 (min j len) in
      String (String.sub s i (max 0 (j - i)))
    | _ -> raise (Eval_error "substring: 3 args"));
  register "substr" (fun args ->
    match args with
    | [String s; start_v; len_v] ->
      let i = as_int start_v and n = as_int len_v in
      let sl = String.length s in
      let i = max 0 (min i sl) in
      let n = max 0 (min n (sl - i)) in
      String (String.sub s i n)
    | [String s; start_v] ->
      let i = as_int start_v in
      let sl = String.length s in
      let i = max 0 (min i sl) in
      String (String.sub s i (sl - i))
    | _ -> raise (Eval_error "substr: 2-3 args"));
  register "split" (fun args ->
    match args with
    | [String s; String sep] ->
      if String.length sep = 1 then
        List (List.map (fun p -> String p) (String.split_on_char sep.[0] s))
      else
        (* Multi-char separator: use Re for literal split *)
        let re = Re.compile (Re.str sep) in
        List (List.map (fun p -> String p) (Re.split re s))
    | _ -> raise (Eval_error "split: 2 args"));
  register "join" (fun args ->
    match args with
    | [String sep; (List items | ListRef { contents = items })] ->
      String (String.concat sep (List.map to_string items))
    | _ -> raise (Eval_error "join: 2 args"));
  register "replace" (fun args ->
    let to_str = function
      | String s -> s | SxExpr s -> s | RawHTML s -> s
      | Keyword k -> k | Symbol s -> s
      | Nil -> "" | Bool true -> "true" | Bool false -> "false"
      | Integer n -> string_of_int n
      | Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n
      | Thunk _ as t -> (match !_sx_trampoline_fn t with String s -> s | v -> to_string v)
      | v -> to_string v
    in
    match args with
    | [s; old_s; new_s] ->
      let s = to_str s and old_s = to_str old_s and new_s = to_str new_s in
      let ol = String.length old_s in
      if ol = 0 then String s
      else begin
        let buf = Buffer.create (String.length s) in
        let rec go i =
          if i >= String.length s then ()
          else if i + ol <= String.length s && String.sub s i ol = old_s then begin
            Buffer.add_string buf new_s;
            go (i + ol)
          end else begin
            Buffer.add_char buf s.[i];
            go (i + 1)
          end
        in go 0;
        String (Buffer.contents buf)
      end
    | _ -> raise (Eval_error "replace: 3 string args"));
  register "char-from-code" (fun args ->
    match args with
    | [a] ->
      let n = as_int a in
      let buf = Buffer.create 4 in
      Buffer.add_utf_8_uchar buf (Uchar.of_int n);
      String (Buffer.contents buf)
    | _ -> raise (Eval_error "char-from-code: 1 arg"));
  register "char-at" (fun args ->
    match args with
    | [String s; n] ->
      let i = as_int n in
      if i >= 0 && i < String.length s then
        String (String.make 1 s.[i])
      else Nil
    | _ -> raise (Eval_error "char-at: string and index"));
  register "char-code" (fun args ->
    match args with
    | [String s] when String.length s > 0 -> Integer (Char.code s.[0])
    | _ -> raise (Eval_error "char-code: 1 non-empty string arg"));
  register "parse-number" (fun args ->
    match args with
    | [String s] ->
      let has_dec = String.contains s '.' in
      let has_exp = String.contains s 'e' || String.contains s 'E' in
      if has_dec || has_exp then
        (try Number (float_of_string s) with Failure _ -> Nil)
      else
        (match int_of_string_opt s with
         | Some n -> Integer n
         | None -> (try Number (float_of_string s) with Failure _ -> Nil))
    | _ -> raise (Eval_error "parse-number: 1 string arg"));

  (* === Regex (PCRE-compatible — same syntax as JS RegExp) === *)
  register "regex-match" (fun args ->
    match args with
    | [String pattern; String input] ->
      (try
        let re = Re.Pcre.re pattern |> Re.compile in
        match Re.exec_opt re input with
        | Some group ->
          let full = Re.Group.get group 0 in
          let n = Re.Group.nb_groups group in
          let groups = ref [String full] in
          for i = 1 to n - 1 do
            (try groups := !groups @ [String (Re.Group.get group i)]
             with Not_found -> groups := !groups @ [Nil])
          done;
          List !groups
        | None -> Nil
       with _ -> Nil)
    | _ -> raise (Eval_error "regex-match: pattern and input strings"));
  register "regex-match?" (fun args ->
    match args with
    | [String pattern; String input] ->
      (try Bool (Re.execp (Re.Pcre.re pattern |> Re.compile) input)
       with _ -> Bool false)
    | _ -> raise (Eval_error "regex-match?: pattern and input strings"));
  register "regex-find-all" (fun args ->
    match args with
    | [String pattern; String input] ->
      (try
        let re = Re.Pcre.re pattern |> Re.compile in
        let matches = Re.all re input in
        let results = List.map (fun group ->
          (* If there's a capture group, return group 1; else full match *)
          try String (Re.Group.get group 1)
          with Not_found -> String (Re.Group.get group 0)
        ) matches in
        ListRef (ref results)
       with _ -> ListRef (ref []))
    | _ -> raise (Eval_error "regex-find-all: pattern and input strings"));
  register "regex-replace" (fun args ->
    match args with
    | [String pattern; String replacement; String input] ->
      (try
        let re = Re.Pcre.re pattern |> Re.compile in
        String (Re.replace_string re ~by:replacement input)
       with _ -> String input)
    | _ -> raise (Eval_error "regex-replace: pattern, replacement, input strings"));
  register "regex-replace-first" (fun args ->
    match args with
    | [String pattern; String replacement; String input] ->
      (try
        let re = Re.Pcre.re pattern |> Re.compile in
        (* Re doesn't have replace_first, so use all matches and replace only first *)
        match Re.exec_opt re input with
        | Some group ->
          let start = Re.Group.start group 0 and stop = Re.Group.stop group 0 in
          String (String.sub input 0 start ^ replacement ^
                  String.sub input stop (String.length input - stop))
        | None -> String input
       with _ -> String input)
    | _ -> raise (Eval_error "regex-replace-first: pattern, replacement, input strings"));
  register "regex-split" (fun args ->
    match args with
    | [String pattern; String input] ->
      (try
        let re = Re.Pcre.re pattern |> Re.compile in
        ListRef (ref (List.map (fun s -> String s) (Re.split re input)))
       with _ -> ListRef (ref [String input]))
    | _ -> raise (Eval_error "regex-split: pattern and input strings"));

  (* === Collections === *)
  register "list" (fun args -> ListRef (ref args));
  register "len" (fun args ->
    match args with
    | [List l] | [ListRef { contents = l }] -> Integer (List.length l)
    | [String s] -> Integer (String.length s)
    | [Dict d] -> Integer (Hashtbl.length d)
    | [Nil] | [Bool false] -> Integer 0
    | [Bool true] -> Integer 1
    | [Number _] | [Integer _] -> Integer 1
    | [RawHTML s] -> Integer (String.length s)
    | [SxExpr s] -> Integer (String.length s)
    | [Spread pairs] -> Integer (List.length pairs)
    | [Component _] | [Island _] | [Lambda _] | [NativeFn _]
    | [Macro _] | [Thunk _] | [Keyword _] | [Symbol _] -> Integer 0
    | _ -> raise (Eval_error (Printf.sprintf "len: %d args"
        (List.length args))));
  register "length" (Hashtbl.find primitives "len");
  register "first" (fun args ->
    match args with
    | [List (x :: _)] | [ListRef { contents = x :: _ }] -> x
    | [List []] | [ListRef { contents = [] }] -> Nil | [Nil] -> Nil
    | [x] -> raise (Eval_error ("first: expected list, got " ^ inspect x))
    | _ -> raise (Eval_error "first: 1 list arg"));
  register "rest" (fun args ->
    match args with
    | [List (_ :: xs)] | [ListRef { contents = _ :: xs }] -> List xs
    | [List []] | [ListRef { contents = [] }] -> List [] | [Nil] -> List []
    | _ -> raise (Eval_error "rest: 1 list arg"));
  register "last" (fun args ->
    match args with
    | [List l] | [ListRef { contents = l }] ->
      (match List.rev l with x :: _ -> x | [] -> Nil)
    | _ -> raise (Eval_error "last: 1 list arg"));
  register "init" (fun args ->
    match args with
    | [List l] | [ListRef { contents = l }] ->
      (match List.rev l with _ :: rest -> List (List.rev rest) | [] -> List [])
    | _ -> raise (Eval_error "init: 1 list arg"));
  register "nth" (fun args ->
    match args with
    | [List l; n] | [ListRef { contents = l }; n] ->
      (try List.nth l (as_int n) with _ -> Nil)
    | [String s; n] ->
      let i = as_int n in
      if i >= 0 && i < String.length s then String (String.make 1 s.[i])
      else Nil
    | _ -> raise (Eval_error "nth: list/string and number"));
  register "cons" (fun args ->
    match args with
    | [x; List l] | [x; ListRef { contents = l }] -> List (x :: l)
    | [x; Nil] -> List [x]
    | _ -> raise (Eval_error "cons: value and list"));
  register "append" (fun args ->
    match args with
    | [List la | ListRef { contents = la }; List lb | ListRef { contents = lb }] ->
      List (la @ lb)
    | [List la | ListRef { contents = la }; Nil] -> List la
    | [Nil; List lb | ListRef { contents = lb }] -> List lb
    | [List la | ListRef { contents = la }; v] -> List (la @ [v])
    | [v; List lb | ListRef { contents = lb }] -> List ([v] @ lb)
    | _ ->
      let all = List.concat_map as_list args in
      List all);
  register "append!" (fun args ->
    match args with
    | [ListRef r; item] -> r := !r @ [item]; ListRef r
    | [List items; item] -> List (items @ [item])
    | _ -> raise (Eval_error "append!: list and item"));
  register "reverse" (fun args ->
    match args with
    | [List l] | [ListRef { contents = l }] -> List (List.rev l)
    | _ -> raise (Eval_error "reverse: 1 list"));
  register "flatten" (fun args ->
    let rec flat = function
      | List items | ListRef { contents = items } -> List.concat_map flat items
      | x -> [x]
    in
    match args with
    | [List l] | [ListRef { contents = l }] -> List (List.concat_map flat l)
    | _ -> raise (Eval_error "flatten: 1 list"));
  register "concat" (fun args -> List (List.concat_map as_list args));
  register "contains?" (fun args ->
    match args with
    | [List l; item] | [ListRef { contents = l }; item] ->
      (* Physical equality first (handles signals/dicts/closures safely),
         structural fallback only for acyclic types (string/number/bool/nil/symbol/keyword) *)
      let safe_eq a b =
        a == b ||
        (match a, b with
         | 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
         | String x, String y -> x = y
         | Bool x, Bool y -> x = y
         | Nil, Nil -> true
         | Symbol x, Symbol y -> x = y
         | Keyword x, Keyword y -> x = y
         | Dict a, Dict b ->
           (match Hashtbl.find_opt a "__host_handle", Hashtbl.find_opt b "__host_handle" with
            | Some (Number ha), Some (Number hb) -> ha = hb
            | _ -> false)
         | _ -> false)
      in
      Bool (List.exists (fun x -> safe_eq x item) l)
    | [String s; String sub] ->
      let rec find i =
        if i + String.length sub > String.length s then false
        else if String.sub s i (String.length sub) = sub then true
        else find (i + 1)
      in Bool (find 0)
    | _ -> raise (Eval_error "contains?: 2 args"));
  register "range" (fun args ->
    match args with
    | [stop_v] ->
      let n = as_int stop_v in
      List (List.init (max 0 n) (fun i -> Integer i))
    | [start_v; stop_v] ->
      let s = as_int start_v and e = as_int stop_v in
      let len = max 0 (e - s) in
      List (List.init len (fun i -> Integer (s + i)))
    | [start_v; stop_v; step_v] ->
      (match start_v, stop_v, step_v with
       | Integer s, Integer e, Integer st ->
         if st = 0 then List []
         else
           let items = ref [] in
           let i = ref s in
           if st > 0 then
             (while !i < e do items := Integer !i :: !items; i := !i + st done)
           else
             (while !i > e do items := Integer !i :: !items; i := !i + st done);
           List (List.rev !items)
       | _ ->
         let s = as_number start_v and e = as_number stop_v and st = as_number step_v in
         if st = 0.0 then List []
         else
           let items = ref [] in
           let i = ref s in
           if st > 0.0 then
             (while !i < e do items := Number !i :: !items; i := !i +. st done)
           else
             (while !i > e do items := Number !i :: !items; i := !i +. st done);
           List (List.rev !items))
    | _ -> raise (Eval_error "range: 1-3 args"));
  register "slice" (fun args ->
    match args with
    | [(List l | ListRef { contents = l }); start_v] ->
      let i = max 0 (as_int start_v) in
      let rec drop n = function _ :: xs when n > 0 -> drop (n-1) xs | l -> l in
      List (drop i l)
    | [(List l | ListRef { contents = l }); start_v; end_v] ->
      let i = max 0 (as_int start_v) and j = as_int end_v in
      let len = List.length l in
      let j = min j len in
      let rec take_range idx = function
        | [] -> []
        | x :: xs ->
          if idx >= j then []
          else if idx >= i then x :: take_range (idx+1) xs
          else take_range (idx+1) xs
      in List (take_range 0 l)
    | [String s; start_v] ->
      let i = max 0 (as_int start_v) in
      String (String.sub s i (max 0 (String.length s - i)))
    | [String s; start_v; end_v] ->
      let i = max 0 (as_int start_v) and j = as_int end_v in
      let sl = String.length s in
      let j = min j sl in
      String (String.sub s i (max 0 (j - i)))
    | _ -> raise (Eval_error "slice: 2-3 args"));
  register "sort" (fun args ->
    match args with
    | [List l] | [ListRef { contents = l }] -> List (List.sort compare l)
    | _ -> raise (Eval_error "sort: 1 list"));
  register "zip" (fun args ->
    match args with
    | [a; b] ->
      let la = as_list a and lb = as_list b in
      let rec go l1 l2 acc = match l1, l2 with
        | x :: xs, y :: ys -> go xs ys (List [x; y] :: acc)
        | _ -> List.rev acc
      in List (go la lb [])
    | _ -> raise (Eval_error "zip: 2 lists"));
  register "zip-pairs" (fun args ->
    match args with
    | [v] ->
      let l = as_list v in
      let rec go = function
        | a :: b :: rest -> List [a; b] :: go rest
        | _ -> []
      in List (go l)
    | _ -> raise (Eval_error "zip-pairs: 1 list"));
  register "take" (fun args ->
    match args with
    | [(List l | ListRef { contents = l }); n] ->
      let rec take_n i = function
        | x :: xs when i > 0 -> x :: take_n (i-1) xs
        | _ -> []
      in List (take_n (as_int n) l)
    | _ -> raise (Eval_error "take: list and number"));
  register "drop" (fun args ->
    match args with
    | [(List l | ListRef { contents = l }); n] ->
      let rec drop_n i = function
        | _ :: xs when i > 0 -> drop_n (i-1) xs
        | l -> l
      in List (drop_n (as_int n) l)
    | _ -> raise (Eval_error "drop: list and number"));
  register "chunk-every" (fun args ->
    match args with
    | [(List l | ListRef { contents = l }); n] ->
      let size = as_int n in
      let rec go = function
        | [] -> []
        | l ->
          let rec take_n i = function
            | x :: xs when i > 0 -> x :: take_n (i-1) xs
            | _ -> []
          in
          let rec drop_n i = function
            | _ :: xs when i > 0 -> drop_n (i-1) xs
            | l -> l
          in
          List (take_n size l) :: go (drop_n size l)
      in List (go l)
    | _ -> raise (Eval_error "chunk-every: list and number"));
  register "unique" (fun args ->
    match args with
    | [(List l | ListRef { contents = l })] ->
      let seen = Hashtbl.create 16 in
      let result = List.filter (fun x ->
        let key = inspect x in
        if Hashtbl.mem seen key then false
        else (Hashtbl.replace seen key true; true)
      ) l in
      List result
    | _ -> raise (Eval_error "unique: 1 list"));

  (* === Dict === *)
  register "dict" (fun args ->
    let d = make_dict () in
    let rec go = function
      | [] -> Dict d
      | Keyword k :: v :: rest -> dict_set d k v; go rest
      | String k :: v :: rest -> dict_set d k v; go rest
      | _ -> raise (Eval_error "dict: pairs of key value")
    in go args);
  register "get" (fun args ->
    match args with
    | [Dict d; String k] -> dict_get d k
    | [Dict d; Keyword k] -> dict_get d k
    | [List l; n] | [ListRef { contents = l }; n]
        when (match n with Number _ | Integer _ -> true | _ -> false) ->
      (try List.nth l (as_int n) with _ -> Nil)
    | [Nil; _] -> Nil  (* nil.anything → nil *)
    | [_; _] -> Nil    (* type mismatch → nil (matches JS/Python behavior) *)
    | _ -> Nil);
  register "has-key?" (fun args ->
    match args with
    | [Dict d; String k] -> Bool (dict_has d k)
    | [Dict d; Keyword k] -> Bool (dict_has d k)
    | _ -> raise (Eval_error "has-key?: dict and key"));
  register "assoc" (fun args ->
    match args with
    | Dict d :: rest ->
      let d2 = Hashtbl.copy d in
      let rec go = function
        | [] -> Dict d2
        | String k :: v :: rest -> Hashtbl.replace d2 k v; go rest
        | Keyword k :: v :: rest -> Hashtbl.replace d2 k v; go rest
        | _ -> raise (Eval_error "assoc: pairs")
      in go rest
    | _ -> raise (Eval_error "assoc: dict + pairs"));
  register "dissoc" (fun args ->
    match args with
    | Dict d :: keys ->
      let d2 = Hashtbl.copy d in
      List.iter (fun k -> Hashtbl.remove d2 (to_string k)) keys;
      Dict d2
    | _ -> raise (Eval_error "dissoc: dict + keys"));
  register "merge" (fun args ->
    let d = make_dict () in
    List.iter (function
      | Dict src -> Hashtbl.iter (fun k v -> Hashtbl.replace d k v) src
      | _ -> raise (Eval_error "merge: all args must be dicts")
    ) args;
    Dict d);
  register "keys" (fun args ->
    match args with [Dict d] -> List (dict_keys d) | _ -> raise (Eval_error "keys: 1 dict"));
  register "vals" (fun args ->
    match args with [Dict d] -> List (dict_vals d) | _ -> raise (Eval_error "vals: 1 dict"));
  register "mutable-list" (fun _args -> ListRef (ref []));
  register "set-nth!" (fun args ->
    match args with
    | [ListRef r; idx; v] ->
      let i = as_int idx in
      let l = !r in
      r := List.mapi (fun j x -> if j = i then v else x) l;
      Nil
    | [List _; _; _] ->
      raise (Eval_error "set-nth!: list is immutable, use ListRef")
    | _ -> raise (Eval_error "set-nth!: expected (list idx val)"));
  register "dict-set!" (fun args ->
    match args with
    | [Dict d; String k; v] -> dict_set d k v; v
    | [Dict d; Keyword k; v] -> dict_set d k v; v
    | _ -> raise (Eval_error "dict-set!: dict key val"));
  register "dict-get" (fun args ->
    match args with
    | [Dict d; String k] -> dict_get d k
    | [Dict d; Keyword k] -> dict_get d k
    | _ -> raise (Eval_error "dict-get: dict and key"));
  register "dict-has?" (fun args ->
    match args with
    | [Dict d; String k] -> Bool (dict_has d k)
    | _ -> raise (Eval_error "dict-has?: dict and key"));
  register "dict-delete!" (fun args ->
    match args with
    | [Dict d; String k] -> dict_delete d k; Nil
    | _ -> raise (Eval_error "dict-delete!: dict and key"));

  (* === Misc === *)
  register "type-of" (fun args ->
    match args with [a] -> String (type_of a) | _ -> raise (Eval_error "type-of: 1 arg"));
  register "inspect" (fun args ->
    match args with [a] -> String (inspect a) | _ -> raise (Eval_error "inspect: 1 arg"));
  register "serialize" (fun args ->
    match args with
    | [SxExpr s] -> String s
    | [RawHTML s] -> String s
    | [Spread pairs] ->
      (* Serialize spread values as (make-spread {:key "val" ...}) *)
      let dict_parts = List.map (fun (k, v) ->
        Printf.sprintf ":%s %s" k (inspect v)) pairs in
      String (Printf.sprintf "(make-spread {%s})" (String.concat " " dict_parts))
    | [Component c] ->
      (* Serialize component values as their ~name reference *)
      String (Printf.sprintf "~%s" c.c_name)
    | [Island i] ->
      String (Printf.sprintf "~%s" i.i_name)
    | [Lambda _] -> String "<lambda>"
    | [Record r] -> String (Printf.sprintf "#<%s>" r.r_type.rt_name)
    | [Parameter p] -> String (Printf.sprintf "#<parameter %s>" p.pm_uid)
    | [Vector arr] ->
      let elts = Array.to_list (Array.map (fun v -> inspect v) arr) in
      String (Printf.sprintf "#(%s)" (String.concat " " elts))
    | [a] -> String (inspect a)  (* used for dedup keys in compiler *)
    | _ -> raise (Eval_error "serialize: 1 arg"));
  register "make-symbol" (fun args ->
    match args with
    | [String s] -> Symbol s
    | _ -> raise (Eval_error "make-symbol: expected string"));
  register "error" (fun args ->
    match args with [String msg] -> raise (Eval_error msg)
    | [a] -> raise (Eval_error (to_string a))
    | _ -> raise (Eval_error "error: 1 arg"));
  register "host-error" (fun args ->
    match args with [String msg] -> raise (Eval_error msg)
    | [a] -> raise (Eval_error (to_string a))
    | _ -> raise (Eval_error "host-error: 1 arg"));
  register "host-warn" (fun args ->
    match args with
    | [String msg] -> prerr_endline msg; Nil
    | [a] -> prerr_endline (to_string a); Nil
    | _ -> raise (Eval_error "host-warn: 1 arg"));
  register "try-catch" (fun args ->
    match args with
    | [try_fn; catch_fn] ->
      (try !_sx_trampoline_fn (!_sx_call_fn try_fn [])
       with Eval_error msg ->
         !_sx_trampoline_fn (!_sx_call_fn catch_fn [String msg]))
    | _ -> raise (Eval_error "try-catch: expected (try-fn catch-fn)"));
  (* client? — false by default (server); sx_browser.ml sets _is_client := true *)
  register "client?" (fun _args -> Bool !_is_client);
  (* Named stores — global mutable registry, bypasses env scoping issues *)
  let store_registry : (string, value) Hashtbl.t = Hashtbl.create 16 in
  register "def-store" (fun args ->
    match args with
    | [String name; init_fn] ->
      if not (Hashtbl.mem store_registry name) then begin
        let store = !_sx_trampoline_fn (!_sx_call_fn init_fn []) in
        Hashtbl.replace store_registry name store
      end;
      (match Hashtbl.find_opt store_registry name with Some v -> v | None -> Nil)
    | _ -> raise (Eval_error "def-store: expected (name init-fn)"));
  register "use-store" (fun args ->
    match args with
    | [String name] ->
      (match Hashtbl.find_opt store_registry name with
       | Some v -> v
       | None -> raise (Eval_error ("Store not found: " ^ name)))
    | _ -> raise (Eval_error "use-store: expected (name)"));
  register "clear-stores" (fun _args -> Hashtbl.clear store_registry; Nil);
  (* SSR stubs — resource returns loading state on server.
     NOTE: effect and register-in-scope must NOT be registered as primitives
     here — the bytecode compiler uses primitive? to decide CALL_PRIM vs
     GLOBAL_GET+CALL. If effect is a primitive, bytecoded modules emit
     CALL_PRIM which returns Nil instead of calling the real effect function
     from core-signals.sx. The server overrides effect in sx_server.ml via
     env_bind AFTER compilation. *)
  (* register "effect" — REMOVED: see note above *)
  (* register "register-in-scope" — REMOVED: see note above *)
  (* resource — SSR stub: return signal with {loading: true}, client hydrates real fetch *)
  register "resource" (fun _args ->
    let state = Hashtbl.create 8 in
    Hashtbl.replace state "loading" (Bool true);
    Hashtbl.replace state "data" Nil;
    Hashtbl.replace state "error" Nil;
    let sig_d = Hashtbl.create 8 in
    Hashtbl.replace sig_d "__signal" (Bool true);
    Hashtbl.replace sig_d "value" (Dict state);
    Hashtbl.replace sig_d "subscribers" (List []);
    Hashtbl.replace sig_d "deps" (List []);
    Dict sig_d);
  register "apply" (fun args ->
    let call f a =
      match f with
      | NativeFn (_, fn) -> fn a
      | _ -> !_sx_trampoline_fn (!_sx_call_fn f a)
    in
    match args with
    | [f; (List a | ListRef { contents = a })] -> call f a
    | [f; Nil] -> call f []
    | _ -> raise (Eval_error "apply: function and list"));
  register "identical?" (fun args ->
    match args with
    | [a; b] ->
      let identical = match a, b with
        | 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
        | String x, String y -> x = y
        | Bool x, Bool y -> x = y
        | Nil, Nil -> true
        | _ -> a == b
      in Bool identical
    | _ -> raise (Eval_error "identical?: 2 args"));
  register "make-spread" (fun args ->
    match args with
    | [Dict d] ->
      let pairs = Hashtbl.fold (fun k v acc -> (k, v) :: acc) d [] in
      Spread pairs
    | _ -> raise (Eval_error "make-spread: 1 dict"));
  register "spread?" (fun args ->
    match args with [Spread _] -> Bool true | [_] -> Bool false
    | _ -> raise (Eval_error "spread?: 1 arg"));
  register "spread-attrs" (fun args ->
    match args with
    | [Spread pairs] ->
      let d = make_dict () in
      List.iter (fun (k, v) -> dict_set d k v) pairs;
      Dict d
    | _ -> raise (Eval_error "spread-attrs: 1 spread"));

  (* Higher-order forms as callable primitives — used by the VM.
     The CEK machine handles these as special forms with dedicated frames;
     the VM needs them as plain callable values. *)
  (* Call any SX callable — handles NativeFn, Lambda (via trampoline), VM closures *)
  let call_any f args =
    match f with
    | NativeFn (_, fn) -> fn args
    | _ -> !_sx_trampoline_fn (!_sx_call_fn f args)
  in
  register "map" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      List (List.map (fun x -> call_any f [x]) items)
    | [_; Nil] -> List []
    | _ -> raise (Eval_error "map: expected (fn list)"));
  register "map-indexed" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      List (List.mapi (fun i x -> call_any f [Integer i; x]) items)
    | [_; Nil] -> List []
    | _ -> raise (Eval_error "map-indexed: expected (fn list)"));
  register "filter" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      List (List.filter (fun x -> sx_truthy (call_any f [x])) items)
    | [_; Nil] -> List []
    | _ -> raise (Eval_error "filter: expected (fn list)"));
  register "for-each" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      List.iter (fun x -> ignore (call_any f [x])) items; Nil
    | [_; Nil] -> Nil  (* nil collection = no-op *)
    | _ ->
      let types = String.concat ", " (List.map (fun v -> type_of v) args) in
      raise (Eval_error (Printf.sprintf "for-each: expected (fn list), got (%s) %d args" types (List.length args))));
  register "reduce" (fun args ->
    match args with
    | [f; init; (List items | ListRef { contents = items })] ->
      List.fold_left (fun acc x -> call_any f [acc; x]) init items
    | _ -> raise (Eval_error "reduce: expected (fn init list)"));
  register "some" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      let rec find = function
        | [] -> Bool false
        | x :: rest ->
          let result = call_any f [x] in
          if sx_truthy result then result else find rest
      in find items
    | [_; Nil] -> Bool false
    | _ -> raise (Eval_error "some: expected (fn list)"));
  register "every?" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      Bool (List.for_all (fun x -> sx_truthy (call_any f [x])) items)
    | [_; Nil] -> Bool true
    | _ -> raise (Eval_error "every?: expected (fn list)"));

  (* ---- VM stack primitives (vm.sx platform interface) ---- *)
  register "make-vm-stack" (fun args ->
    match args with
    | [n] -> ListRef (ref (List.init (as_int n) (fun _ -> Nil)))
    | _ -> raise (Eval_error "make-vm-stack: expected (size)"));
  register "vm-stack-get" (fun args ->
    match args with
    | [ListRef r; n] -> List.nth !r (as_int n)
    | _ -> raise (Eval_error "vm-stack-get: expected (stack idx)"));
  register "vm-stack-set!" (fun args ->
    match args with
    | [ListRef r; n; v] ->
      let i = as_int n in
      r := List.mapi (fun j x -> if j = i then v else x) !r; Nil
    | _ -> raise (Eval_error "vm-stack-set!: expected (stack idx val)"));
  register "vm-stack-length" (fun args ->
    match args with
    | [ListRef r] -> Integer (List.length !r)
    | _ -> raise (Eval_error "vm-stack-length: expected (stack)"));
  register "vm-stack-copy!" (fun args ->
    match args with
    | [ListRef src; ListRef dst; n] ->
      let count = as_int n in
      let src_items = !src in
      dst := List.mapi (fun i x -> if i < count then List.nth src_items i else x) !dst; Nil
    | _ -> raise (Eval_error "vm-stack-copy!: expected (src dst count)"));
  register "primitive?" (fun args ->
    match args with
    | [String name] -> Bool (Hashtbl.mem primitives name)
    | _ -> Bool false);

  (* Scope stack primitives are registered by sx_server.ml / run_tests.ml
     because they use a shared scope stacks table with collect!/collected. *)

  (* ---- Predicates needed by adapter-html.sx ---- *)
  register "lambda?" (fun args ->
    match args with [Lambda _] -> Bool true | _ -> Bool false);
  register "island?" (fun args ->
    match args with [Island _] -> Bool true | _ -> Bool false);

  (* R7RS records *)
  register "record?" (fun args ->
    match args with [v] -> record_p v | _ -> Bool false);
  register "make-rtd" (fun args ->
    match args with [name; fields; ctor_params] -> make_rtd name fields ctor_params
    | _ -> raise (Eval_error "make-rtd: expected (name fields ctor-params)"));
  register "make-record" (fun args ->
    match args with [uid; arg_list] -> make_record uid arg_list
    | _ -> raise (Eval_error "make-record: expected (uid args-list)"));
  register "record-ref" (fun args ->
    match args with [v; idx] -> record_ref v idx
    | _ -> raise (Eval_error "record-ref: expected (record index)"));
  register "record-set!" (fun args ->
    match args with [v; idx; nv] -> record_set_b v idx nv
    | _ -> raise (Eval_error "record-set!: expected (record index value)"));
  register "record-type?" (fun args ->
    match args with [v; uid] -> record_type_p v uid | _ -> Bool false);
  register "make-record-constructor" (fun args ->
    match args with [uid] -> make_record_constructor uid
    | _ -> raise (Eval_error "make-record-constructor: expected (uid)"));
  register "make-record-predicate" (fun args ->
    match args with [uid] -> make_record_predicate uid
    | _ -> raise (Eval_error "make-record-predicate: expected (uid)"));
  register "make-record-accessor" (fun args ->
    match args with [idx] -> make_record_accessor idx
    | _ -> raise (Eval_error "make-record-accessor: expected (index)"));
  register "make-record-mutator" (fun args ->
    match args with [idx] -> make_record_mutator idx
    | _ -> raise (Eval_error "make-record-mutator: expected (index)"));
  (* R7RS parameters — converter stored, applied by parameterize frame *)
  register "make-parameter" (fun args ->
    match args with
    | [init] ->
      let uid = !param_counter in
      incr param_counter;
      Parameter { pm_uid = "__param_" ^ string_of_int uid;
                  pm_default = init; pm_converter = None }
    | [init; converter] ->
      let uid = !param_counter in
      incr param_counter;
      (* Apply converter to init for NativeFn, store raw for Lambda *)
      let converted = match converter with
        | NativeFn (_, f) -> f [init]
        | _ -> init  (* Lambda converters applied via CEK at parameterize time *)
      in
      Parameter { pm_uid = "__param_" ^ string_of_int uid;
                  pm_default = converted; pm_converter = Some converter }
    | _ -> raise (Eval_error "make-parameter: expected 1-2 args"));
  register "parameter?" (fun args ->
    match args with [Parameter _] -> Bool true | [_] -> Bool false
    | _ -> Bool false);
  register "parameter-uid" (fun args ->
    match args with [Parameter p] -> String p.pm_uid
    | _ -> raise (Eval_error "parameter-uid: expected parameter"));
  register "parameter-default" (fun args ->
    match args with [Parameter p] -> p.pm_default
    | _ -> raise (Eval_error "parameter-default: expected parameter"));
  register "parameter-converter" (fun args ->
    match args with
    | [Parameter p] -> (match p.pm_converter with Some c -> c | None -> Nil)
    | _ -> raise (Eval_error "parameter-converter: expected parameter"));
  (* R7RS vectors — mutable fixed-size arrays *)
  register "make-vector" (fun args ->
    match args with
    | [n] -> Vector (Array.make (as_int n) Nil)
    | [n; fill] -> Vector (Array.make (as_int n) fill)
    | _ -> raise (Eval_error "make-vector: expected (length) or (length fill)"));
  register "vector" (fun args -> Vector (Array.of_list args));
  register "vector?" (fun args ->
    match args with [Vector _] -> Bool true | [_] -> Bool false
    | _ -> raise (Eval_error "vector?: 1 arg"));
  register "vector-length" (fun args ->
    match args with [Vector arr] -> Integer (Array.length arr)
    | _ -> raise (Eval_error "vector-length: expected vector"));
  register "vector-ref" (fun args ->
    match args with
    | [Vector arr; n] ->
      let i = as_int n in
      if i < 0 || i >= Array.length arr then
        raise (Eval_error (Printf.sprintf "vector-ref: index %d out of bounds (length %d)" i (Array.length arr)));
      arr.(i)
    | _ -> raise (Eval_error "vector-ref: expected (vector index)"));
  register "vector-set!" (fun args ->
    match args with
    | [Vector arr; n; v] ->
      let i = as_int n in
      if i < 0 || i >= Array.length arr then
        raise (Eval_error (Printf.sprintf "vector-set!: index %d out of bounds (length %d)" i (Array.length arr)));
      arr.(i) <- v; Nil
    | _ -> raise (Eval_error "vector-set!: expected (vector index value)"));
  register "vector->list" (fun args ->
    match args with [Vector arr] -> List (Array.to_list arr)
    | _ -> raise (Eval_error "vector->list: expected vector"));
  register "list->vector" (fun args ->
    match args with
    | [List l] -> Vector (Array.of_list l)
    | [ListRef { contents = l }] -> Vector (Array.of_list l)
    | _ -> raise (Eval_error "list->vector: expected list"));
  register "vector-fill!" (fun args ->
    match args with
    | [Vector arr; v] -> Array.fill arr 0 (Array.length arr) v; Nil
    | _ -> raise (Eval_error "vector-fill!: expected (vector value)"));
  register "vector-copy" (fun args ->
    match args with
    | [Vector arr] -> Vector (Array.copy arr)
    | [Vector arr; s] ->
      let start = as_int s in
      let len = Array.length arr - start in
      if len <= 0 then Vector [||] else Vector (Array.sub arr start len)
    | [Vector arr; s; e] ->
      let start = as_int s in
      let stop = min (as_int e) (Array.length arr) in
      let len = stop - start in
      if len <= 0 then Vector [||] else Vector (Array.sub arr start len)
    | _ -> raise (Eval_error "vector-copy: expected (vector) or (vector start) or (vector start end)"));

  (* String buffers — O(1) amortised append for string building in loops *)
  register "make-string-buffer" (fun _ -> StringBuffer (Buffer.create 64));
  register "string-buffer?" (fun args ->
    match args with [StringBuffer _] -> Bool true | [_] -> Bool false
    | _ -> raise (Eval_error "string-buffer?: expected 1 arg"));
  register "string-buffer-append!" (fun args ->
    match args with
    | [StringBuffer buf; String s] -> Buffer.add_string buf s; Nil
    | [StringBuffer _; v] -> raise (Eval_error ("string-buffer-append!: expected string, got " ^ type_of v))
    | _ -> raise (Eval_error "string-buffer-append!: expected (buffer string)"));
  register "string-buffer->string" (fun args ->
    match args with [StringBuffer buf] -> String (Buffer.contents buf)
    | _ -> raise (Eval_error "string-buffer->string: expected (buffer)"));
  register "string-buffer-length" (fun args ->
    match args with [StringBuffer buf] -> Integer (Buffer.length buf)
    | _ -> raise (Eval_error "string-buffer-length: expected (buffer)"));

  (* Short aliases — same StringBuffer value, terser names for hot paths.
     Append accepts any value: strings pass through, others get inspected/coerced. *)
  register "make-buffer" (fun _ -> StringBuffer (Buffer.create 64));
  register "buffer?" (fun args ->
    match args with [StringBuffer _] -> Bool true | [_] -> Bool false
    | _ -> raise (Eval_error "buffer?: expected 1 arg"));
  register "buffer-append!" (fun args ->
    match args with
    | [StringBuffer buf; String s] -> Buffer.add_string buf s; Nil
    | [StringBuffer buf; Integer n] -> Buffer.add_string buf (string_of_int n); Nil
    | [StringBuffer buf; Number n] -> Buffer.add_string buf (Sx_types.format_number n); Nil
    | [StringBuffer buf; Symbol s] -> Buffer.add_string buf s; Nil
    | [StringBuffer buf; Char n] ->
      Buffer.add_utf_8_uchar buf (Uchar.of_int n); Nil
    | [StringBuffer buf; Nil] -> Buffer.add_string buf ""; Nil
    | [StringBuffer buf; Bool true] -> Buffer.add_string buf "true"; Nil
    | [StringBuffer buf; Bool false] -> Buffer.add_string buf "false"; Nil
    | [StringBuffer buf; v] -> Buffer.add_string buf (inspect v); Nil
    | _ -> raise (Eval_error "buffer-append!: expected (buffer value)"));
  register "buffer->string" (fun args ->
    match args with [StringBuffer buf] -> String (Buffer.contents buf)
    | _ -> raise (Eval_error "buffer->string: expected (buffer)"));
  register "buffer-length" (fun args ->
    match args with [StringBuffer buf] -> Integer (Buffer.length buf)
    | _ -> raise (Eval_error "buffer-length: expected (buffer)"));

  (* Capability-based sandboxing — gate IO operations *)
  let cap_stack : string list ref = ref [] in
  register "with-capabilities" (fun args ->
    match args with
    | [List caps; body] ->
      let cap_set = List.filter_map (fun v -> match v with
        | Symbol s | String s | Keyword s -> Some s | _ -> None) caps in
      let prev = !cap_stack in
      cap_stack := cap_set;
      (match body with
       | Lambda _ | NativeFn _ | VmClosure _ ->
         let result = (try !Sx_types._cek_call_ref body Nil
           with exn -> cap_stack := prev; raise exn) in
         cap_stack := prev; result
       | _ -> cap_stack := prev; body)
    | [ListRef { contents = caps }; body] ->
      (* Handle mutable lists too *)
      let cap_set = List.filter_map (fun v -> match v with
        | Symbol s | String s | Keyword s -> Some s | _ -> None) caps in
      let prev = !cap_stack in
      cap_stack := cap_set;
      (match body with
       | Lambda _ | NativeFn _ | VmClosure _ ->
         let result = (try !Sx_types._cek_call_ref body Nil
           with exn -> cap_stack := prev; raise exn) in
         cap_stack := prev; result
       | _ -> cap_stack := prev; body)
    | _ -> raise (Eval_error "with-capabilities: expected (cap-list body-fn)"));
  register "current-capabilities" (fun _args ->
    if !cap_stack = [] then Nil
    else List (List.map (fun s -> String s) !cap_stack));
  register "has-capability?" (fun args ->
    match args with
    | [String cap] | [Keyword cap] | [Symbol cap] ->
      if !cap_stack = [] then Bool true  (* unrestricted *)
      else Bool (List.mem cap !cap_stack)
    | _ -> Bool true);
  register "require-capability!" (fun args ->
    match args with
    | [String cap] | [Keyword cap] | [Symbol cap] ->
      if !cap_stack = [] then Nil  (* unrestricted *)
      else if List.mem cap !cap_stack then Nil
      else raise (Eval_error (Printf.sprintf
        "Capability '%s' not available. Current capabilities: [%s]"
        cap (String.concat ", " !cap_stack)))
    | _ -> Nil);
  register "capability-restricted?" (fun _args ->
    Bool (!cap_stack <> []));

  register "is-else-clause?" (fun args ->
    match args with
    | [Keyword "else"] -> Bool true
    | [Bool true] -> Bool true
    | _ -> Bool false);
  register "cond-scheme?" (fun args ->
    match args with
    | [List clauses] ->
      Bool (List.for_all (fun c ->
        match c with
        | List l -> List.length l = 2
        | _ -> false) clauses)
    | _ -> Bool false);
  register "component?" (fun args ->
    match args with [Component _] -> Bool true | [Island _] -> Bool true | _ -> Bool false);
  register "lambda-closure" (fun args ->
    match args with [Lambda l] -> Env l.l_closure | _ -> Nil);
  register "component-closure" (fun args ->
    match args with
    | [Component c] -> Env c.c_closure
    | [Island i] -> Env i.i_closure
    | _ -> Nil);
  register "component-has-children?" (fun args ->
    match args with
    | [Component c] -> Bool c.c_has_children
    | [Island i] -> Bool i.i_has_children
    | _ -> Bool false);
  register "component-name" (fun args ->
    match args with
    | [Component c] -> String c.c_name
    | [Island i] -> String i.i_name
    | _ -> Nil);
  register "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)
    | _ -> List []);
  register "component-body" (fun args ->
    match args with
    | [Component c] -> c.c_body
    | [Island i] -> i.i_body
    | _ -> Nil);
  register "component-file" (fun args ->
    match args with [v] -> component_file v | _ -> Nil);
  register "component-set-file!" (fun args ->
    match args with [v; f] -> component_set_file v f | _ -> Nil);
  register "macro?" (fun args ->
    match args with [Macro _] -> Bool true | _ -> Bool false);
  register "for-each-indexed" (fun args ->
    match args with
    | [f; (List items | ListRef { contents = items })] ->
      List.iteri (fun i x -> ignore (call_any f [Number (float_of_int i); x])) items; Nil
    | _ -> raise (Eval_error "for-each-indexed: expected (fn list)"));
  register "lambda-params" (fun args ->
    match args with
    | [Lambda l] -> List (List.map (fun s -> String s) l.l_params)
    | _ -> List []);
  register "lambda-body" (fun args ->
    match args with [Lambda l] -> l.l_body | _ -> Nil);
  (* expand-macro is registered later by run_tests.ml / sx_server.ml
     because it needs eval_expr which creates a dependency cycle *);
  register "empty-dict?" (fun args ->
    match args with
    | [Dict d] -> Bool (Hashtbl.length d = 0)
    | _ -> Bool true);
  register "make-raw-html" (fun args ->
    match args with [String s] -> RawHTML s | _ -> Nil);
  register "raw-html-content" (fun args ->
    match args with [RawHTML s] -> String s | _ -> String "");
  register "get-primitive" (fun args ->
    match args with
    | [String name] ->
      (match Hashtbl.find_opt primitives name with
       | Some fn -> NativeFn (name, fn)
       | None -> raise (Eval_error ("VM undefined: " ^ name)))
    | _ -> raise (Eval_error "get-primitive: expected (name)"));
  register "call-primitive" (fun args ->
    match args with
    | [String name; (List a | ListRef { contents = a })] ->
      (match Hashtbl.find_opt primitives name with
       | Some fn -> fn a
       | None -> raise (Eval_error ("VM undefined: " ^ name)))
    | [String name; Nil] ->
      (match Hashtbl.find_opt primitives name with
       | Some fn -> fn []
       | None -> raise (Eval_error ("VM undefined: " ^ name)))
    | _ -> raise (Eval_error "call-primitive: expected (name args-list)"));
  ();

  (* ================================================================ *)
  (* Scope stacks — dynamic scope for render-time effects.            *)
  (* Migrated from sx_scope.ml — Phase 1 of step 5.5                 *)
  (* ================================================================ *)

  (* --- Cookies --- *)

  register "get-cookie" (fun args ->
    match args with
    | [String name] ->
      (match Hashtbl.find_opt _request_cookies name with
       | Some v -> String v
       | None -> Nil)
    | _ -> Nil);

  register "set-cookie" (fun _args -> Nil);

  (* --- Core scope stack operations --- *)

  register "scope-push!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      if !_scope_trace then
        _scope_log := Printf.sprintf "PUSH %s depth=%d->%d" name (List.length stack) (List.length stack + 1) :: !_scope_log;
      Hashtbl.replace _scope_stacks name (value :: stack); Nil
    | _ -> Nil);

  register "scope-pop!" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      if !_scope_trace then
        _scope_log := Printf.sprintf "POP %s depth=%d->%d" name (List.length stack) (max 0 (List.length stack - 1)) :: !_scope_log;
      (match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
    | _ -> Nil);

  register "scope-peek" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      if !_scope_trace then
        _scope_log := Printf.sprintf "PEEK %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log;
      (match stack with v :: _ -> v | [] -> Nil)
    | _ -> Nil);

  (* --- Context (scope lookup with optional default) --- *)

  register "context" (fun args ->
    match args with
    | (String name) :: rest ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      if !_scope_trace then
        _scope_log := Printf.sprintf "CTX %s depth=%d found=%b" name (List.length stack) (stack <> []) :: !_scope_log;
      (match stack with
       | v :: _ -> v
       | [] -> (match rest with default_val :: _ -> default_val | [] -> Nil))
    | _ -> Nil);

  register "context-debug" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      let all_keys = Hashtbl.fold (fun k _ acc -> k :: acc) _scope_stacks [] in
      String (Printf.sprintf "name=%s stack_len=%d all_keys=[%s]"
        name (List.length stack) (String.concat "," all_keys))
    | _ -> String "bad args");

  (* --- Collect / collected / clear-collected! --- *)

  register "collect!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | List items :: rest ->
         if not (List.mem value items) then
           Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
       | [] ->
         Hashtbl.replace _scope_stacks name [List [value]]
       | _ :: _ -> ());
      Nil
    | _ -> Nil);

  register "collected" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with List items :: _ -> List items | _ -> List [])
    | _ -> List []);

  register "clear-collected!" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | _ :: rest -> Hashtbl.replace _scope_stacks name (List [] :: rest)
       | [] -> Hashtbl.replace _scope_stacks name [List []]);
      Nil
    | _ -> Nil);

  (* --- Unified reactive model (Step 10c) ---
     provide wraps value in a Signal (reactive cell).
     context unwraps the signal + registers in tracking context.
     peek unwraps without tracking.
     provide! mutates the signal and notifies subscribers. *)

  let _tracking_active : bool ref = ref false in
  let _tracking_deps : value list ref = ref [] in

  register "provide-reactive!" (fun args ->
    match args with
    | [String name; value] ->
      let sig' = { s_value = value; s_subscribers = []; s_deps = [] } in
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      Hashtbl.replace _scope_stacks name (Signal sig' :: stack); Nil
    | _ -> raise (Eval_error "provide-reactive!: expected (name value)"));

  register "provide-pop-reactive!" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
    | _ -> Nil);

  register "provide-set!" (fun args ->
    match args with
    | [String name; new_value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | Signal sig' :: _ ->
         sig'.s_value <- new_value;
         List.iter (fun sub -> sub ()) sig'.s_subscribers;
         Nil
       | _ -> raise (Eval_error (Printf.sprintf
           "provide-set!: '%s' is not a reactive provide" name)))
    | _ -> raise (Eval_error "provide-set!: expected (name new-value)"));

  register "peek" (fun args ->
    match args with
    | (String name) :: _ ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | Signal sig' :: _ -> sig'.s_value
       | v :: _ -> v
       | [] -> Nil)
    | _ -> raise (Eval_error "peek: expected (name)"));

  register "tracking-start!" (fun _args ->
    _tracking_active := true; _tracking_deps := []; Nil);

  register "tracking-stop!" (fun _args ->
    _tracking_active := false;
    let deps = !_tracking_deps in
    _tracking_deps := [];
    List deps);

  register "tracking-active?" (fun _args ->
    Bool !_tracking_active);

  (* Override context to be tracking-aware *)
  Hashtbl.remove primitives "context";
  register "context" (fun args ->
    match args with
    | (String name) :: rest ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | Signal sig' :: _ ->
         (* Register in tracking context if active *)
         if !_tracking_active then begin
           if not (List.memq (Signal sig') !_tracking_deps) then
             _tracking_deps := Signal sig' :: !_tracking_deps
         end;
         sig'.s_value
       | v :: _ -> v
       | [] -> (match rest with default_val :: _ -> default_val | [] -> Nil))
    | _ -> Nil);

  (* tracking-register-scope! — explicitly register a reactive provide as a dep *)
  register "tracking-register-scope!" (fun args ->
    match args with
    | [String name] ->
      if !_tracking_active then begin
        let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
        match stack with
        | Signal sig' :: _ ->
          if not (List.memq (Signal sig') !_tracking_deps) then
            _tracking_deps := Signal sig' :: !_tracking_deps;
          Nil
        | _ -> Nil
      end else Nil
    | _ -> Nil);

  (* deref — unwrap a signal value with reactive dependency tracking.
     If value is a Signal, returns s_value and registers in tracking context.
     Otherwise returns value as-is. *)
  register "deref" (fun args ->
    match args with
    | [Signal sig'] ->
      if !_tracking_active then begin
        if not (List.memq (Signal sig') !_tracking_deps) then
          _tracking_deps := Signal sig' :: !_tracking_deps
      end;
      sig'.s_value
    | [v] -> v
    | _ -> Nil);

  (* bind — create a tracked computation. Takes a body-fn (lambda).
     Starts tracking, evaluates body, collects deps, subscribes.
     On dep change: unsubscribes, re-evaluates, re-subscribes.
     Returns initial value. Optional update-fn called with new values. *)
  register "bind" (fun args ->
    match args with
    | [body_fn] | [body_fn; _] ->
      let update_fn = match args with [_; u] -> Some u | _ -> None in
      let disposers : (unit -> unit) list ref = ref [] in
      let rec run_tracked () =
        (* Clean up previous subscriptions *)
        List.iter (fun d -> d ()) !disposers;
        disposers := [];
        (* Start tracking *)
        _tracking_active := true;
        _tracking_deps := [];
        (* Evaluate body *)
        let result = !Sx_types._cek_call_ref body_fn Nil in
        (* Collect deps *)
        let deps = !_tracking_deps in
        _tracking_active := false;
        _tracking_deps := [];
        (* Subscribe to each dep *)
        List.iter (fun dep ->
          match dep with
          | Signal sig' ->
            let subscriber = (fun () ->
              let new_result = run_tracked () in
              match update_fn with
              | Some f -> ignore (!Sx_types._cek_call_ref f (List [new_result]))
              | None -> ()
            ) in
            sig'.s_subscribers <- subscriber :: sig'.s_subscribers;
            disposers := (fun () ->
              sig'.s_subscribers <- List.filter (fun s -> s != subscriber) sig'.s_subscribers
            ) :: !disposers
          | _ -> ()
        ) deps;
        result
      in
      run_tracked ()
    | _ -> raise (Eval_error "bind: expected (body-fn) or (body-fn update-fn)"));

  (* --- Emit / emitted --- *)

  register "scope-emit!" (fun args ->
    match args with
    | [String name; value] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with
       | List items :: rest ->
         Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
       | Nil :: rest ->
         Hashtbl.replace _scope_stacks name (List [value] :: rest)
       | [] ->
         Hashtbl.replace _scope_stacks name [List [value]]
       | _ :: _ -> ());
      Nil
    | _ -> Nil);

  register "emit!" (fun args ->
    match Hashtbl.find_opt primitives "scope-emit!" with
    | Some fn -> fn args | None -> Nil);

  register "emitted" (fun args ->
    match args with
    | [String name] ->
      let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
      (match stack with List items :: _ -> List items | _ -> List [])
    | _ -> List []);

  register "scope-emitted" (fun args ->
    match Hashtbl.find_opt primitives "emitted" with
    | Some fn -> fn args | None -> List []);

  register "scope-collected" (fun args ->
    match Hashtbl.find_opt primitives "collected" with
    | Some fn -> fn args | None -> List []);

  register "scope-clear-collected!" (fun args ->
    match Hashtbl.find_opt primitives "clear-collected!" with
    | Some fn -> fn args | None -> Nil);

  (* --- Provide aliases --- *)

  register "provide-push!" (fun args ->
    match Hashtbl.find_opt primitives "scope-push!" with
    | Some fn -> fn args | None -> Nil);

  register "provide-pop!" (fun args ->
    match Hashtbl.find_opt primitives "scope-pop!" with
    | Some fn -> fn args | None -> Nil);

  (* hs-safe-call: invoke a 0-arg thunk, return nil on any native error.
     Used by the hyperscript compiler to wrap collection expressions in
     for-loops, so `for x in doesNotExist` iterates over nil instead of
     crashing with an undefined-symbol error. *)
  register "hs-safe-call" (fun args ->
    match args with
    | [thunk] ->
      (try !Sx_types._cek_call_ref thunk Nil
       with _ -> Nil)
    | _ -> Nil);

  (* === Regex === wrapping Re + Re.Pcre *)
  let regex_table : (int, Re.re * string * string) Hashtbl.t = Hashtbl.create 32 in
  let regex_next_id = ref 0 in
  let parse_flags flags =
    let opts = ref [] in
    String.iter (function
      | 'i' -> opts := `CASELESS :: !opts
      | 'm' -> opts := `MULTILINE :: !opts
      | 's' -> opts := `DOTALL :: !opts
      | _ -> ()) flags;
    !opts
  in
  let make_regex_value id source flags =
    let d = Hashtbl.create 4 in
    Hashtbl.replace d "__regex__" (Bool true);
    Hashtbl.replace d "id" (Number (float_of_int id));
    Hashtbl.replace d "source" (String source);
    Hashtbl.replace d "flags" (String flags);
    Dict d
  in
  let regex_of_value = function
    | Dict d ->
      (match Hashtbl.find_opt d "id" with
       | Some (Number n) ->
         (match Hashtbl.find_opt regex_table (int_of_float n) with
          | Some r -> r
          | None -> raise (Eval_error "regex: handle not found"))
       | _ -> raise (Eval_error "regex: missing id"))
    | _ -> raise (Eval_error "regex: expected regex dict")
  in
  let group_to_dict g input =
    let d = Hashtbl.create 4 in
    Hashtbl.replace d "match" (String (Re.Group.get g 0));
    Hashtbl.replace d "index" (Number (float_of_int (Re.Group.start g 0)));
    Hashtbl.replace d "input" (String input);
    let count = Re.Group.nb_groups g in
    let groups = ref [] in
    for i = count - 1 downto 1 do
      let s = try Re.Group.get g i with Not_found -> "" in
      groups := String s :: !groups
    done;
    Hashtbl.replace d "groups" (List !groups);
    Dict d
  in
  register "regex-compile" (fun args ->
    match args with
    | [String source; String flags] | [String source; String flags; _] ->
      let opts = parse_flags flags in
      (try
        let re = Re.compile (Re.Pcre.re ~flags:opts source) in
        let id = !regex_next_id in
        incr regex_next_id;
        Hashtbl.replace regex_table id (re, source, flags);
        make_regex_value id source flags
      with _ -> raise (Eval_error ("regex-compile: invalid pattern " ^ source)))
    | [String source] ->
      (try
        let re = Re.compile (Re.Pcre.re source) in
        let id = !regex_next_id in
        incr regex_next_id;
        Hashtbl.replace regex_table id (re, source, "");
        make_regex_value id source ""
      with _ -> raise (Eval_error ("regex-compile: invalid pattern " ^ source)))
    | _ -> raise (Eval_error "regex-compile: (source flags)"));
  register "regex-test" (fun args ->
    match args with
    | [rx; String s] ->
      let (re, _, _) = regex_of_value rx in
      Bool (Re.execp re s)
    | _ -> raise (Eval_error "regex-test: (regex string)"));
  register "regex-exec" (fun args ->
    let (rx, s, start) = match args with
      | [rx; String s] -> (rx, s, 0)
      | [rx; String s; Number n] -> (rx, s, int_of_float n)
      | _ -> raise (Eval_error "regex-exec: (regex string start?)")
    in
    let (re, _, _) = regex_of_value rx in
    try
      let g = Re.exec ~pos:start re s in
      group_to_dict g s
    with Not_found -> Nil);
  register "regex-match-all" (fun args ->
    match args with
    | [rx; String s] ->
      let (re, _, _) = regex_of_value rx in
      let all = Re.all re s in
      List (List.map (fun g -> group_to_dict g s) all)
    | _ -> raise (Eval_error "regex-match-all: (regex string)"));
  register "regex-replace" (fun args ->
    match args with
    | [rx; String s; String replacement] ->
      let (re, _, flags) = regex_of_value rx in
      let expand g =
        let buf = Buffer.create (String.length replacement) in
        let i = ref 0 in
        let n = String.length replacement in
        while !i < n do
          let c = replacement.[!i] in
          if c = '$' && !i + 1 < n then
            (match replacement.[!i + 1] with
             | '&' -> Buffer.add_string buf (Re.Group.get g 0); i := !i + 2
             | '$' -> Buffer.add_char buf '$'; i := !i + 2
             | c when c >= '0' && c <= '9' ->
               let idx = Char.code c - Char.code '0' in
               (try Buffer.add_string buf (Re.Group.get g idx) with Not_found -> ());
               i := !i + 2
             | _ -> Buffer.add_char buf c; incr i)
          else (Buffer.add_char buf c; incr i)
        done;
        Buffer.contents buf
      in
      let global = String.contains flags 'g' in
      if global then
        String (Re.replace re ~f:expand s)
      else
        (match Re.exec_opt re s with
         | None -> String s
         | Some g ->
           let repl = expand g in
           let before = String.sub s 0 (Re.Group.start g 0) in
           let after_start = Re.Group.stop g 0 in
           let after = String.sub s after_start (String.length s - after_start) in
           String (before ^ repl ^ after))
    | _ -> raise (Eval_error "regex-replace: (regex string replacement)"));
  register "regex-replace-fn" (fun args ->
    match args with
    | [rx; String s; f] ->
      let (re, _, flags) = regex_of_value rx in
      let call_fn g =
        let match_str = Re.Group.get g 0 in
        let count = Re.Group.nb_groups g in
        let groups_before = ref [] in
        for i = count - 1 downto 1 do
          let v = try String (Re.Group.get g i) with Not_found -> Nil in
          groups_before := v :: !groups_before
        done;
        let idx = Number (float_of_int (Re.Group.start g 0)) in
        let all_args = [String match_str] @ !groups_before @ [idx; String s] in
        match !Sx_types._cek_call_ref f (List all_args) with
        | String s -> s
        | Number n -> Sx_types.format_number n
        | v -> Sx_types.inspect v
      in
      let global = String.contains flags 'g' in
      if global then
        String (Re.replace re ~f:call_fn s)
      else
        (match Re.exec_opt re s with
         | None -> String s
         | Some g ->
           let repl = call_fn g in
           let before = String.sub s 0 (Re.Group.start g 0) in
           let after_start = Re.Group.stop g 0 in
           let after = String.sub s after_start (String.length s - after_start) in
           String (before ^ repl ^ after))
    | _ -> raise (Eval_error "regex-replace-fn: (regex string fn)"));
  register "regex-split" (fun args ->
    match args with
    | [rx; String s] ->
      let (re, _, _) = regex_of_value rx in
      List (List.map (fun x -> String x) (Re.split re s))
    | _ -> raise (Eval_error "regex-split: (regex string)"));
  register "regex-source" (fun args ->
    match args with
    | [rx] ->
      let (_, source, _) = regex_of_value rx in
      String source
    | _ -> raise (Eval_error "regex-source: (regex)"));
  register "regex-flags" (fun args ->
    match args with
    | [rx] ->
      let (_, _, flags) = regex_of_value rx in
      String flags
    | _ -> raise (Eval_error "regex-flags: (regex)"));

  (* make-regexp / regexp? / regexp-match / regexp-match-all / regexp-replace / regexp-replace-all / regexp-split *)
  let parse_re_flags flags =
    let opts = ref [] in
    String.iter (function
      | 'i' -> opts := `CASELESS :: !opts
      | 'm' -> opts := `MULTILINE :: !opts
      | 's' -> opts := `DOTALL :: !opts
      | _ -> ()) flags;
    !opts
  in
  let make_regexp_value source flags =
    let opts = parse_re_flags flags in
    try
      let compiled = Re.compile (Re.Pcre.re ~flags:opts source) in
      SxRegexp (source, flags, compiled)
    with _ -> raise (Eval_error ("make-regexp: invalid pattern: " ^ source))
  in
  let match_dict g input =
    let d = Hashtbl.create 4 in
    Hashtbl.replace d "match" (String (Re.Group.get g 0));
    Hashtbl.replace d "start" (Integer (Re.Group.start g 0));
    Hashtbl.replace d "end" (Integer (Re.Group.stop g 0));
    Hashtbl.replace d "input" (String input);
    let count = Re.Group.nb_groups g in
    let groups = ref [] in
    for i = count - 1 downto 1 do
      let s = try Re.Group.get g i with Not_found -> "" in
      groups := String s :: !groups
    done;
    Hashtbl.replace d "groups" (List !groups);
    Dict d
  in
  register "make-regexp" (fun args ->
    match args with
    | [String src] -> make_regexp_value src ""
    | [String src; String flags] -> make_regexp_value src flags
    | _ -> raise (Eval_error "make-regexp: (pattern [flags])"));
  register "regexp?" (fun args ->
    match args with
    | [SxRegexp _] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "regexp?: 1 arg"));
  register "regexp-source" (fun args ->
    match args with
    | [SxRegexp (src, _, _)] -> String src
    | _ -> raise (Eval_error "regexp-source: expected regexp"));
  register "regexp-flags" (fun args ->
    match args with
    | [SxRegexp (_, flags, _)] -> String flags
    | _ -> raise (Eval_error "regexp-flags: expected regexp"));
  register "regexp-match" (fun args ->
    match args with
    | [SxRegexp (_, _, re); String s] ->
      (match Re.exec_opt re s with
       | None -> Nil
       | Some g -> match_dict g s)
    | _ -> raise (Eval_error "regexp-match: (regexp string)"));
  register "regexp-match-all" (fun args ->
    match args with
    | [SxRegexp (_, _, re); String s] ->
      List (List.map (fun g -> match_dict g s) (Re.all re s))
    | _ -> raise (Eval_error "regexp-match-all: (regexp string)"));
  register "regexp-replace" (fun args ->
    match args with
    | [SxRegexp (_, _, re); String s; String replacement] ->
      (match Re.exec_opt re s with
       | None -> String s
       | Some g ->
         let buf = Buffer.create (String.length s) in
         let i = ref 0 in
         let n = String.length replacement in
         let expand () =
           while !i < n do
             let c = replacement.[!i] in
             if c = '$' && !i + 1 < n then
               (match replacement.[!i + 1] with
                | '&' -> Buffer.add_string buf (Re.Group.get g 0); i := !i + 2
                | '$' -> Buffer.add_char buf '$'; i := !i + 2
                | c when c >= '0' && c <= '9' ->
                  let idx = Char.code c - Char.code '0' in
                  (try Buffer.add_string buf (Re.Group.get g idx) with Not_found -> ());
                  i := !i + 2
                | _ -> Buffer.add_char buf c; incr i)
             else (Buffer.add_char buf c; incr i)
           done
         in
         Buffer.add_string buf (String.sub s 0 (Re.Group.start g 0));
         expand ();
         Buffer.add_string buf (String.sub s (Re.Group.stop g 0)
           (String.length s - Re.Group.stop g 0));
         String (Buffer.contents buf))
    | _ -> raise (Eval_error "regexp-replace: (regexp string replacement)"));
  register "regexp-replace-all" (fun args ->
    match args with
    | [SxRegexp (_, _, re); String s; String replacement] ->
      let expand g =
        let buf = Buffer.create (String.length replacement) in
        let i = ref 0 in
        let n = String.length replacement in
        while !i < n do
          let c = replacement.[!i] in
          if c = '$' && !i + 1 < n then
            (match replacement.[!i + 1] with
             | '&' -> Buffer.add_string buf (Re.Group.get g 0); i := !i + 2
             | '$' -> Buffer.add_char buf '$'; i := !i + 2
             | c when c >= '0' && c <= '9' ->
               let idx = Char.code c - Char.code '0' in
               (try Buffer.add_string buf (Re.Group.get g idx) with Not_found -> ());
               i := !i + 2
             | _ -> Buffer.add_char buf c; incr i)
          else (Buffer.add_char buf c; incr i)
        done;
        Buffer.contents buf
      in
      String (Re.replace re ~f:expand s)
    | _ -> raise (Eval_error "regexp-replace-all: (regexp string replacement)"));
  register "regexp-split" (fun args ->
    match args with
    | [SxRegexp (_, _, re); String s] ->
      List (List.map (fun x -> String x) (Re.split re s))
    | _ -> raise (Eval_error "regexp-split: (regexp string)"));
  (* Bitwise operations *)
  register "bitwise-and" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (a land b)
    | _ -> raise (Eval_error "bitwise-and: expected (integer integer)"));
  register "bitwise-or" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (a lor b)
    | _ -> raise (Eval_error "bitwise-or: expected (integer integer)"));
  register "bitwise-xor" (fun args ->
    match args with
    | [Integer a; Integer b] -> Integer (a lxor b)
    | _ -> raise (Eval_error "bitwise-xor: expected (integer integer)"));
  register "bitwise-not" (fun args ->
    match args with
    | [Integer a] -> Integer (lnot a)
    | _ -> raise (Eval_error "bitwise-not: expected (integer)"));
  register "arithmetic-shift" (fun args ->
    match args with
    | [Integer a; Integer count] ->
      Integer (if count >= 0 then a lsl count else a asr (-count))
    | _ -> raise (Eval_error "arithmetic-shift: expected (integer integer)"));
  register "bit-count" (fun args ->
    match args with
    | [Integer a] ->
      let n = ref (abs a) in
      let c = ref 0 in
      while !n <> 0 do
        c := !c + (!n land 1);
        n := !n lsr 1
      done;
      Integer !c
    | _ -> raise (Eval_error "bit-count: expected (integer)"));
  register "integer-length" (fun args ->
    match args with
    | [Integer a] ->
      let n = ref (abs a) in
      let bits = ref 0 in
      while !n <> 0 do
        incr bits;
        n := !n lsr 1
      done;
      Integer !bits
    | _ -> raise (Eval_error "integer-length: expected (integer)"));

  (* Phase 10: mutable hash tables *)
  register "make-hash-table" (fun _ -> HashTable (Hashtbl.create 16));
  register "hash-table?" (fun args ->
    match args with
    | [HashTable _] -> Bool true
    | [_] -> Bool false
    | _ -> Bool false);
  register "hash-table-set!" (fun args ->
    match args with
    | [HashTable ht; k; v] ->
      (try Hashtbl.replace ht k v
       with _ ->
         (* fallback: scan for physically equal key *)
         let found = ref false in
         Hashtbl.iter (fun ek _ -> if ek == k then (Hashtbl.replace ht ek v; found := true)) ht;
         if not !found then Hashtbl.replace ht k v);
      Nil
    | _ -> raise (Eval_error "hash-table-set!: expected (ht key val)"));
  register "hash-table-ref" (fun args ->
    match args with
    | [HashTable ht; k] ->
      (try Hashtbl.find ht k
       with Not_found -> raise (Eval_error ("hash-table-ref: key not found")))
    | [HashTable ht; k; default] ->
      (try Hashtbl.find ht k with Not_found -> default)
    | _ -> raise (Eval_error "hash-table-ref: expected (ht key) or (ht key default)"));
  register "hash-table-delete!" (fun args ->
    match args with
    | [HashTable ht; k] -> Hashtbl.remove ht k; Nil
    | _ -> raise (Eval_error "hash-table-delete!: expected (ht key)"));
  register "hash-table-size" (fun args ->
    match args with
    | [HashTable ht] -> Integer (Hashtbl.length ht)
    | _ -> raise (Eval_error "hash-table-size: expected (ht)"));
  register "hash-table-keys" (fun args ->
    match args with
    | [HashTable ht] -> List (Hashtbl.fold (fun k _ acc -> k :: acc) ht [])
    | _ -> raise (Eval_error "hash-table-keys: expected (ht)"));
  register "hash-table-values" (fun args ->
    match args with
    | [HashTable ht] -> List (Hashtbl.fold (fun _ v acc -> v :: acc) ht [])
    | _ -> raise (Eval_error "hash-table-values: expected (ht)"));
  register "hash-table->alist" (fun args ->
    match args with
    | [HashTable ht] ->
      List (Hashtbl.fold (fun k v acc -> List [k; v] :: acc) ht [])
    | _ -> raise (Eval_error "hash-table->alist: expected (ht)"));
  register "hash-table-for-each" (fun args ->
    match args with
    | [HashTable ht; fn] ->
      Hashtbl.iter (fun k v -> ignore (!Sx_types._cek_call_ref fn (List [k; v]))) ht;
      Nil
    | _ -> raise (Eval_error "hash-table-for-each: expected (ht fn)"));
  register "hash-table-merge!" (fun args ->
    match args with
    | [HashTable dst; HashTable src] ->
      Hashtbl.iter (fun k v -> Hashtbl.replace dst k v) src;
      Nil
    | _ -> raise (Eval_error "hash-table-merge!: expected (dst src)"));
  (* Phase 11: sequence protocol *)
  let seq_to_list v =
    match v with
    | Nil -> List []
    | List _ -> v
    | ListRef { contents = items } -> List items
    | Vector arr -> List (Array.to_list arr)
    | String s ->
      let chars = ref [] in
      String.iter (fun c -> chars := String (String.make 1 c) :: !chars) s;
      List (List.rev !chars)
    | _ -> v
  in
  register "seq-to-list" (fun args ->
    match args with
    | [v] -> seq_to_list v
    | _ -> raise (Eval_error "seq-to-list: expected 1 arg"));
  register "sequence-to-list" (fun args ->
    match args with
    | [v] -> seq_to_list v
    | _ -> raise (Eval_error "sequence-to-list: expected 1 arg"));
  register "sequence-to-vector" (fun args ->
    match args with
    | [v] -> (match seq_to_list v with List xs -> Vector (Array.of_list xs) | x -> x)
    | _ -> raise (Eval_error "sequence-to-vector: expected 1 arg"));
  register "sequence-length" (fun args ->
    match args with
    | [String s] -> Integer (String.length s)
    | [Vector arr] -> Integer (Array.length arr)
    | [v] -> (match seq_to_list v with
        | List xs -> Integer (List.length xs)
        | _ -> raise (Eval_error "sequence-length: expected sequence"))
    | _ -> raise (Eval_error "sequence-length: expected 1 arg"));
  register "sequence-ref" (fun args ->
    match args with
    | [String s; Integer i] ->
      if i < 0 || i >= String.length s
      then raise (Eval_error (Printf.sprintf "sequence-ref: index %d out of bounds" i))
      else String (String.make 1 (String.get s i))
    | [String s; Number n] ->
      let i = int_of_float n in
      if i < 0 || i >= String.length s
      then raise (Eval_error (Printf.sprintf "sequence-ref: index %d out of bounds" i))
      else String (String.make 1 (String.get s i))
    | [v; idx] ->
      let lst = seq_to_list v in
      let i = (match idx with Integer n -> n | Number n -> int_of_float n | _ -> raise (Eval_error "sequence-ref: index must be number")) in
      (match lst with
       | List xs ->
         (try List.nth xs i
          with _ -> raise (Eval_error (Printf.sprintf "sequence-ref: index %d out of bounds" i)))
       | _ -> raise (Eval_error "sequence-ref: expected sequence"))
    | _ -> raise (Eval_error "sequence-ref: expected (seq index)"));
  register "sequence-append" (fun args ->
    match args with
    | [String s1; String s2] -> String (s1 ^ s2)
    | [v1; v2] ->
      let l1 = seq_to_list v1 in
      let l2 = seq_to_list v2 in
      (match l1, l2 with
       | List xs1, List xs2 -> List (xs1 @ xs2)
       | _ -> raise (Eval_error "sequence-append: expected sequences"))
    | _ -> raise (Eval_error "sequence-append: expected 2 args"));
  register "in-range" (fun args ->
    match args with
    | [Integer n] ->
      let rec build i acc = if i < 0 then acc else build (i-1) (Integer i :: acc) in
      List (build (n-1) [])
    | [Number n] ->
      let hi = int_of_float n in
      let rec build i acc = if i < 0 then acc else build (i-1) (Integer i :: acc) in
      List (build (hi-1) [])
    | [Integer lo; Integer hi] ->
      let rec build i acc = if i < lo then acc else build (i-1) (Integer i :: acc) in
      List (build (hi-1) [])
    | [Number lo; Number hi] ->
      let lo_i = int_of_float lo and hi_i = int_of_float hi in
      let rec build i acc = if i < lo_i then acc else build (i-1) (Integer i :: acc) in
      List (build (hi_i-1) [])
    | [Integer lo; Integer hi; Integer step] ->
      if step = 0 then raise (Eval_error "in-range: step cannot be zero");
      let rec build i acc =
        if (step > 0 && i >= hi) || (step < 0 && i <= hi) then acc
        else build (i + step) (Integer i :: acc) in
      List (List.rev (build lo []))
    | _ -> raise (Eval_error "in-range: expected (end) or (start end) or (start end step)"));
  (* === gensym + symbol interning === *)
  register "gensym" (fun args ->
    let prefix = match args with
      | [] -> "g"
      | [String s] -> s
      | [Symbol s] -> s
      | _ -> raise (Eval_error "gensym: expected optional prefix string") in
    incr gensym_counter;
    Symbol (prefix ^ string_of_int !gensym_counter));
  register "string->symbol" (fun args ->
    match args with
    | [String s] -> Symbol s
    | _ -> raise (Eval_error "string->symbol: expected 1 string"));
  register "symbol->string" (fun args ->
    match args with
    | [Symbol s] -> String s
    | _ -> raise (Eval_error "symbol->string: expected 1 symbol"));
  register "intern" (fun args ->
    match args with
    | [String s] -> Symbol s
    | _ -> raise (Eval_error "intern: expected 1 string"));
  register "symbol-interned?" (fun args ->
    match args with
    | [Symbol _] -> Bool true
    | _ -> raise (Eval_error "symbol-interned?: expected 1 symbol"));
  (* Phase 13: character type *)
  let char_downcase_cp n =
    if n >= 65 && n <= 90 then n + 32 else n in
  let char_upcase_cp n =
    if n >= 97 && n <= 122 then n - 32 else n in
  register "make-char" (fun args ->
    match args with
    | [Integer n] -> Char n
    | _ -> raise (Eval_error "make-char: expected integer codepoint"));
  register "char?" (fun args ->
    match args with
    | [Char _] -> Bool true | [_] -> Bool false
    | _ -> raise (Eval_error "char?: expected 1 argument"));
  register "char->integer" (fun args ->
    match args with
    | [Char n] -> Integer n
    | _ -> raise (Eval_error "char->integer: expected char"));
  register "integer->char" (fun args ->
    match args with
    | [Integer n] -> Char n
    | _ -> raise (Eval_error "integer->char: expected integer"));
  register "char-upcase" (fun args ->
    match args with
    | [Char n] -> Char (char_upcase_cp n)
    | _ -> raise (Eval_error "char-upcase: expected char"));
  register "char-downcase" (fun args ->
    match args with
    | [Char n] -> Char (char_downcase_cp n)
    | _ -> raise (Eval_error "char-downcase: expected char"));
  register "char=?"  (fun args -> match args with [Char a; Char b] -> Bool (a = b)  | _ -> raise (Eval_error "char=?: expected 2 chars"));
  register "char<?"  (fun args -> match args with [Char a; Char b] -> Bool (a < b)  | _ -> raise (Eval_error "char<?: expected 2 chars"));
  register "char>?"  (fun args -> match args with [Char a; Char b] -> Bool (a > b)  | _ -> raise (Eval_error "char>?: expected 2 chars"));
  register "char<=?" (fun args -> match args with [Char a; Char b] -> Bool (a <= b) | _ -> raise (Eval_error "char<=?: expected 2 chars"));
  register "char>=?" (fun args -> match args with [Char a; Char b] -> Bool (a >= b) | _ -> raise (Eval_error "char>=?: expected 2 chars"));
  register "char-ci=?"  (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a = char_downcase_cp b) | _ -> raise (Eval_error "char-ci=?: expected 2 chars"));
  register "char-ci<?"  (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a < char_downcase_cp b) | _ -> raise (Eval_error "char-ci<?: expected 2 chars"));
  register "char-ci>?"  (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a > char_downcase_cp b) | _ -> raise (Eval_error "char-ci>?: expected 2 chars"));
  register "char-ci<=?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a <= char_downcase_cp b) | _ -> raise (Eval_error "char-ci<=?: expected 2 chars"));
  register "char-ci>=?" (fun args -> match args with [Char a; Char b] -> Bool (char_downcase_cp a >= char_downcase_cp b) | _ -> raise (Eval_error "char-ci>=?: expected 2 chars"));
  register "char-alphabetic?" (fun args ->
    match args with
    | [Char n] -> Bool ((n >= 65 && n <= 90) || (n >= 97 && n <= 122))
    | _ -> raise (Eval_error "char-alphabetic?: expected char"));
  register "char-numeric?" (fun args ->
    match args with
    | [Char n] -> Bool (n >= 48 && n <= 57)
    | _ -> raise (Eval_error "char-numeric?: expected char"));
  register "char-whitespace?" (fun args ->
    match args with
    | [Char n] -> Bool (n = 32 || n = 9 || n = 10 || n = 13)
    | _ -> raise (Eval_error "char-whitespace?: expected char"));
  register "char-upper-case?" (fun args ->
    match args with
    | [Char n] -> Bool (n >= 65 && n <= 90)
    | _ -> raise (Eval_error "char-upper-case?: expected char"));
  register "char-lower-case?" (fun args ->
    match args with
    | [Char n] -> Bool (n >= 97 && n <= 122)
    | _ -> raise (Eval_error "char-lower-case?: expected char"));
  register "string->list" (fun args ->
    match args with
    | [String s] ->
      let chars = ref [] in
      String.iter (fun c -> chars := Char (Char.code c) :: !chars) s;
      List (List.rev !chars)
    | _ -> raise (Eval_error "string->list: expected string"));
  register "list->string" (fun args ->
    match args with
    | [List chars] | [ListRef { contents = chars }] ->
      let buf = Buffer.create (List.length chars) in
      List.iter (function
        | Char n -> Buffer.add_char buf (Char.chr (n land 0xFF))
        | v -> raise (Eval_error ("list->string: expected char, got " ^ type_of v))
      ) chars;
      String (Buffer.contents buf)
    | _ -> raise (Eval_error "list->string: expected list of chars"));
  (* Phase 14 — EOF object + string ports *)
  register "eof-object" (fun _args -> Eof);
  register "eof-object?" (fun args ->
    match args with
    | [Eof] -> Bool true
    | [_]   -> Bool false
    | _ -> raise (Eval_error "eof-object?: expected 1 argument"));
  register "open-input-string" (fun args ->
    match args with
    | [String s] ->
      Port { sp_closed = false; sp_kind = PortInput (s, ref 0) }
    | _ -> raise (Eval_error "open-input-string: expected string"));
  register "open-output-string" (fun args ->
    match args with
    | [] -> Port { sp_closed = false; sp_kind = PortOutput (Buffer.create 64) }
    | _ -> raise (Eval_error "open-output-string: expected no arguments"));
  register "get-output-string" (fun args ->
    match args with
    | [Port { sp_kind = PortOutput buf; _ }] -> String (Buffer.contents buf)
    | _ -> raise (Eval_error "get-output-string: expected output port"));
  register "port?" (fun args ->
    match args with
    | [Port _] -> Bool true
    | [_]      -> Bool false
    | _ -> raise (Eval_error "port?: expected 1 argument"));
  register "input-port?" (fun args ->
    match args with
    | [Port { sp_kind = PortInput _; _ }] -> Bool true
    | [_]                                  -> Bool false
    | _ -> raise (Eval_error "input-port?: expected 1 argument"));
  register "output-port?" (fun args ->
    match args with
    | [Port { sp_kind = PortOutput _; _ }] -> Bool true
    | [_]                                   -> Bool false
    | _ -> raise (Eval_error "output-port?: expected 1 argument"));
  register "close-port" (fun args ->
    match args with
    | [Port p] -> p.sp_closed <- true; Nil
    | _ -> raise (Eval_error "close-port: expected port"));
  register "read-char" (fun args ->
    match args with
    | [] -> raise (Eval_error "read-char: no default port in this host")
    | [Port p] ->
      (match p.sp_kind with
       | PortOutput _ -> raise (Eval_error "read-char: expected input port")
       | PortInput (src, pos) ->
         if p.sp_closed || !pos >= String.length src then Eof
         else begin
           let cp = Char.code src.[!pos] in
           incr pos;
           Char cp
         end)
    | _ -> raise (Eval_error "read-char: expected input port"));
  register "peek-char" (fun args ->
    match args with
    | [] -> raise (Eval_error "peek-char: no default port in this host")
    | [Port p] ->
      (match p.sp_kind with
       | PortOutput _ -> raise (Eval_error "peek-char: expected input port")
       | PortInput (src, pos) ->
         if p.sp_closed || !pos >= String.length src then Eof
         else Char (Char.code src.[!pos]))
    | _ -> raise (Eval_error "peek-char: expected input port"));
  register "read-line" (fun args ->
    match args with
    | [] -> raise (Eval_error "read-line: no default port in this host")
    | [Port p] ->
      (match p.sp_kind with
       | PortOutput _ -> raise (Eval_error "read-line: expected input port")
       | PortInput (src, pos) ->
         if p.sp_closed || !pos >= String.length src then Eof
         else begin
           let start = !pos in
           let len = String.length src in
           while !pos < len && src.[!pos] <> '\n' do incr pos done;
           let line = String.sub src start (!pos - start) in
           if !pos < len then incr pos;
           String line
         end)
    | _ -> raise (Eval_error "read-line: expected input port"));
  register "write-char" (fun args ->
    match args with
    | [Char n; Port p] ->
      (match p.sp_kind with
       | PortInput _ -> raise (Eval_error "write-char: expected output port")
       | PortOutput buf ->
         if not p.sp_closed then
           Buffer.add_char buf (Char.chr (n land 0xFF));
         Nil)
    | _ -> raise (Eval_error "write-char: expected char and output port"));
  register "write-string" (fun args ->
    match args with
    | [String s; Port p] ->
      (match p.sp_kind with
       | PortInput _ -> raise (Eval_error "write-string: expected output port")
       | PortOutput buf ->
         if not p.sp_closed then Buffer.add_string buf s;
         Nil)
    | _ -> raise (Eval_error "write-string: expected string and output port"));
  register "char-ready?" (fun args ->
    match args with
    | [Port { sp_closed = false; sp_kind = PortInput (src, pos); _ }] ->
      Bool (!pos < String.length src)
    | [Port _] -> Bool false
    | _ -> raise (Eval_error "char-ready?: expected input port"))
;
  (* === read / write / display === *)
  let rec read_postprocess = function
    | List [] -> Nil
    | List items -> List (List.map read_postprocess items)
    | v -> v
  in
  register "read" (fun args ->
    match args with
    | [] -> Eof
    | [Port p] ->
      (match p.sp_kind with
       | PortOutput _ -> raise (Eval_error "read: expected input port")
       | PortInput (src, pos) ->
         let len = String.length src in
         if p.sp_closed || !pos >= len then Eof
         else begin
           let sub = String.sub src !pos (len - !pos) in
           let s = Sx_parser.make_state sub in
           Sx_parser.skip_whitespace_and_comments s;
           if Sx_parser.at_end s then (pos := len; Eof)
           else
             (try let form = read_postprocess (Sx_parser.read_value s) in
                  pos := !pos + s.pos; form
              with _ -> pos := len; Eof)
         end)
    | _ -> raise (Eval_error "read: expected optional input port"));
  register "write" (fun args ->
    match args with
    | [v] -> String (sx_write_val v)
    | [v; Port p] ->
      (match p.sp_kind with
       | PortInput _ -> raise (Eval_error "write: expected output port")
       | PortOutput buf ->
         if not p.sp_closed then Buffer.add_string buf (sx_write_val v);
         Nil)
    | _ -> raise (Eval_error "write: expected val [port]"));
  register "display" (fun args ->
    match args with
    | [v] -> String (sx_display_val v)
    | [v; Port p] ->
      (match p.sp_kind with
       | PortInput _ -> raise (Eval_error "display: expected output port")
       | PortOutput buf ->
         if not p.sp_closed then Buffer.add_string buf (sx_display_val v);
         Nil)
    | _ -> raise (Eval_error "display: expected val [port]"));
  register "newline" (fun args ->
    match args with
    | [] -> Nil
    | [Port p] ->
      (match p.sp_kind with
       | PortInput _ -> raise (Eval_error "newline: expected output port")
       | PortOutput buf ->
         if not p.sp_closed then Buffer.add_char buf '\n';
         Nil)
    | _ -> raise (Eval_error "newline: expected optional output port"));
  register "write-to-string" (fun args ->
    match args with
    | [v] -> String (sx_write_val v)
    | _ -> raise (Eval_error "write-to-string: 1 arg"));
  register "display-to-string" (fun args ->
    match args with
    | [v] -> String (sx_display_val v)
    | _ -> raise (Eval_error "display-to-string: 1 arg"));
  register "format-decimal" (fun args ->
    match args with
    | [Integer n; Integer prec] -> String (Printf.sprintf "%.*f" prec (float_of_int n))
    | [Number n;  Integer prec] -> String (Printf.sprintf "%.*f" prec n)
    | [Integer n; _] -> String (Printf.sprintf "%.6f" (float_of_int n))
    | [Number n;  _] -> String (Printf.sprintf "%.6f" n)
    | _ -> raise (Eval_error "format-decimal: expected number precision"));
  register "current-input-port"  (fun _ -> Nil);
  register "current-output-port" (fun _ -> Nil);
  register "current-error-port"  (fun _ -> Nil);
  (* ---- Sets ---- *)
  let set_key v = Sx_types.inspect v in
  register "make-set" (fun args ->
    let ht = Hashtbl.create 8 in
    (match args with
     | [] -> ()
     | [List items] -> List.iter (fun v -> Hashtbl.replace ht (set_key v) v) items
     | [ListRef r] -> List.iter (fun v -> Hashtbl.replace ht (set_key v) v) !r
     | _ -> raise (Eval_error "make-set: expected optional list"));
    SxSet ht);
  register "set?" (fun args ->
    match args with
    | [SxSet _] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "set?: 1 arg"));
  register "set-add!" (fun args ->
    match args with
    | [SxSet ht; v] -> Hashtbl.replace ht (set_key v) v; Nil
    | _ -> raise (Eval_error "set-add!: expected set val"));
  register "set-member?" (fun args ->
    match args with
    | [SxSet ht; v] -> Bool (Hashtbl.mem ht (set_key v))
    | _ -> raise (Eval_error "set-member?: expected set val"));
  register "set-remove!" (fun args ->
    match args with
    | [SxSet ht; v] -> Hashtbl.remove ht (set_key v); Nil
    | _ -> raise (Eval_error "set-remove!: expected set val"));
  register "set-size" (fun args ->
    match args with
    | [SxSet ht] -> Integer (Hashtbl.length ht)
    | _ -> raise (Eval_error "set-size: expected set"));
  register "set->list" (fun args ->
    match args with
    | [SxSet ht] -> List (Hashtbl.fold (fun _ v acc -> v :: acc) ht [])
    | _ -> raise (Eval_error "set->list: expected set"));
  register "list->set" (fun args ->
    match args with
    | [List items] ->
      let ht = Hashtbl.create (List.length items) in
      List.iter (fun v -> Hashtbl.replace ht (set_key v) v) items;
      SxSet ht
    | [ListRef r] ->
      let ht = Hashtbl.create (List.length !r) in
      List.iter (fun v -> Hashtbl.replace ht (set_key v) v) !r;
      SxSet ht
    | [Nil] -> SxSet (Hashtbl.create 0)
    | _ -> raise (Eval_error "list->set: expected list"));
  register "set-union" (fun args ->
    match args with
    | [SxSet a; SxSet b] ->
      let ht = Hashtbl.copy a in
      Hashtbl.iter (fun k v -> Hashtbl.replace ht k v) b;
      SxSet ht
    | _ -> raise (Eval_error "set-union: expected 2 sets"));
  register "set-intersection" (fun args ->
    match args with
    | [SxSet a; SxSet b] ->
      let ht = Hashtbl.create 8 in
      Hashtbl.iter (fun k v -> if Hashtbl.mem b k then Hashtbl.replace ht k v) a;
      SxSet ht
    | _ -> raise (Eval_error "set-intersection: expected 2 sets"));
  register "set-difference" (fun args ->
    match args with
    | [SxSet a; SxSet b] ->
      let ht = Hashtbl.create 8 in
      Hashtbl.iter (fun k v -> if not (Hashtbl.mem b k) then Hashtbl.replace ht k v) a;
      SxSet ht
    | _ -> raise (Eval_error "set-difference: expected 2 sets"));
  register "set-for-each" (fun args ->
    match args with
    | [SxSet ht; fn] ->
      Hashtbl.iter (fun _ v -> ignore (!Sx_types._cek_call_ref fn (List [v]))) ht;
      Nil
    | _ -> raise (Eval_error "set-for-each: expected set fn"));
  register "set-map" (fun args ->
    match args with
    | [SxSet ht; fn] ->
      let out = Hashtbl.create (Hashtbl.length ht) in
      Hashtbl.iter (fun _ v ->
        let r = !Sx_types._cek_call_ref fn (List [v]) in
        Hashtbl.replace out (set_key r) r) ht;
      SxSet out
    | _ -> raise (Eval_error "set-map: expected set fn"));
  (* === Bytevectors === *)
  register "make-bytevector" (fun args ->
    match args with
    | [Integer n] -> SxBytevector (Bytes.make n '\000')
    | [Integer n; Integer fill] ->
      if fill < 0 || fill > 255 then raise (Eval_error "make-bytevector: fill must be 0-255");
      SxBytevector (Bytes.make n (Char.chr fill))
    | _ -> raise (Eval_error "make-bytevector: expected n [fill]"));
  register "bytevector?" (fun args ->
    match args with
    | [SxBytevector _] -> Bool true
    | [_] -> Bool false
    | _ -> raise (Eval_error "bytevector?: 1 arg"));
  register "bytevector-length" (fun args ->
    match args with
    | [SxBytevector b] -> Integer (Bytes.length b)
    | _ -> raise (Eval_error "bytevector-length: expected bytevector"));
  register "bytevector-u8-ref" (fun args ->
    match args with
    | [SxBytevector b; Integer i] ->
      if i < 0 || i >= Bytes.length b then
        raise (Eval_error (Printf.sprintf "bytevector-u8-ref: index %d out of range" i));
      Integer (Char.code (Bytes.get b i))
    | _ -> raise (Eval_error "bytevector-u8-ref: expected bytevector index"));
  register "bytevector-u8-set!" (fun args ->
    match args with
    | [SxBytevector b; Integer i; Integer byte] ->
      if i < 0 || i >= Bytes.length b then
        raise (Eval_error (Printf.sprintf "bytevector-u8-set!: index %d out of range" i));
      if byte < 0 || byte > 255 then
        raise (Eval_error "bytevector-u8-set!: byte must be 0-255");
      Bytes.set b i (Char.chr byte); Nil
    | _ -> raise (Eval_error "bytevector-u8-set!: expected bytevector index byte"));
  register "bytevector-copy" (fun args ->
    match args with
    | [SxBytevector b] -> SxBytevector (Bytes.copy b)
    | [SxBytevector b; Integer start] ->
      let len = Bytes.length b - start in
      SxBytevector (Bytes.sub b start len)
    | [SxBytevector b; Integer start; Integer stop] ->
      SxBytevector (Bytes.sub b start (stop - start))
    | _ -> raise (Eval_error "bytevector-copy: expected bytevector [start [end]]"));
  register "bytevector-copy!" (fun args ->
    let do_copy dst at src start stop =
      let len = stop - start in
      Bytes.blit src start dst at len; Nil
    in
    match args with
    | [SxBytevector dst; Integer at; SxBytevector src] ->
      do_copy dst at src 0 (Bytes.length src)
    | [SxBytevector dst; Integer at; SxBytevector src; Integer start] ->
      do_copy dst at src start (Bytes.length src)
    | [SxBytevector dst; Integer at; SxBytevector src; Integer start; Integer stop] ->
      do_copy dst at src start stop
    | _ -> raise (Eval_error "bytevector-copy!: expected dst at src [start [end]]"));
  register "bytevector-append" (fun args ->
    let bufs = List.map (function
      | SxBytevector b -> b
      | _ -> raise (Eval_error "bytevector-append: expected bytevectors")) args in
    let total = List.fold_left (fun acc b -> acc + Bytes.length b) 0 bufs in
    let result = Bytes.create total in
    let pos = ref 0 in
    List.iter (fun b ->
      let len = Bytes.length b in
      Bytes.blit b 0 result !pos len;
      pos := !pos + len) bufs;
    SxBytevector result);
  register "utf8->string" (fun args ->
    match args with
    | [SxBytevector b] -> String (Bytes.to_string b)
    | [SxBytevector b; Integer start] ->
      String (Bytes.sub_string b start (Bytes.length b - start))
    | [SxBytevector b; Integer start; Integer stop] ->
      String (Bytes.sub_string b start (stop - start))
    | _ -> raise (Eval_error "utf8->string: expected bytevector [start [end]]"));
  register "string->utf8" (fun args ->
    match args with
    | [String s] -> SxBytevector (Bytes.of_string s)
    | [String s; Integer start] ->
      let len = String.length s - start in
      SxBytevector (Bytes.of_string (String.sub s start len))
    | [String s; Integer start; Integer stop] ->
      SxBytevector (Bytes.of_string (String.sub s start (stop - start)))
    | _ -> raise (Eval_error "string->utf8: expected string [start [end]]"));
  register "bytevector->list" (fun args ->
    match args with
    | [SxBytevector b] ->
      let items = List.init (Bytes.length b) (fun i -> Integer (Char.code (Bytes.get b i))) in
      List items
    | _ -> raise (Eval_error "bytevector->list: expected bytevector"));
  register "list->bytevector" (fun args ->
    match args with
    | [List items] | [ListRef { contents = items }] ->
      let bytes_list = List.map (function
        | Integer n when n >= 0 && n <= 255 -> Char.chr n
        | Integer n -> raise (Eval_error (Printf.sprintf "list->bytevector: byte %d out of range" n))
        | v -> raise (Eval_error ("list->bytevector: expected integer, got " ^ Sx_types.type_of v))) items in
      let b = Bytes.create (List.length bytes_list) in
      List.iteri (fun i c -> Bytes.set b i c) bytes_list;
      SxBytevector b
    | [Nil] -> SxBytevector (Bytes.create 0)
    | _ -> raise (Eval_error "list->bytevector: expected list"));

  (* === File I/O === *)
  register "file-read" (fun args ->
    match args with
    | [String path] ->
      (try
        let ic = open_in path in
        let n = in_channel_length ic in
        let s = Bytes.create n in
        really_input ic s 0 n;
        close_in ic;
        String (Bytes.to_string s)
      with Sys_error msg -> raise (Eval_error ("file-read: " ^ msg)))
    | _ -> raise (Eval_error "file-read: (path)"));

  (* fed-sx Step 3 segment replay. Sorted names, no "."/".." ;
     errors prefixed like file-read (msg carries enoent/enotdir). *)
  register "file-list-dir" (fun args ->
    match args with
    | [String path] ->
      (try
        let names = Sys.readdir path in
        let names =
          Array.to_list names
          |> List.filter (fun n -> n <> "." && n <> "..") in
        let names = List.sort compare names in
        List (List.map (fun n -> String n) names)
      with Sys_error msg -> raise (Eval_error ("file-list-dir: " ^ msg)))
    | _ -> raise (Eval_error "file-list-dir: (path)"));

  register "file-write" (fun args ->
    match args with
    | [String path; String content] ->
      (try
        let oc = open_out path in
        output_string oc content;
        close_out oc;
        Nil
      with Sys_error msg -> raise (Eval_error ("file-write: " ^ msg)))
    | _ -> raise (Eval_error "file-write: (path content)"));

  register "file-append" (fun args ->
    match args with
    | [String path; String content] ->
      (try
        let oc = open_out_gen [Open_append; Open_creat; Open_wronly; Open_text] 0o644 path in
        output_string oc content;
        close_out oc;
        Nil
      with Sys_error msg -> raise (Eval_error ("file-append: " ^ msg)))
    | _ -> raise (Eval_error "file-append: (path content)"));

  register "file-exists?" (fun args ->
    match args with
    | [String path] -> Bool (Sys.file_exists path)
    | _ -> raise (Eval_error "file-exists?: (path)"));

  register "file-glob" (fun args ->
    let glob_match pat str =
      let pn = String.length pat and sn = String.length str in
      let rec go pi si =
        if pi = pn then si = sn
        else match pat.[pi] with
          | '*' ->
            let rec try_from i = i <= sn && (go (pi+1) i || try_from (i+1)) in
            try_from si
          | '?' -> si < sn && go (pi+1) (si+1)
          | '[' ->
            let pi' = ref (pi+1) in
            let negate = !pi' < pn && pat.[!pi'] = '^' in
            if negate then incr pi';
            let matched = ref false in
            while !pi' < pn && pat.[!pi'] <> ']' do
              let c1 = pat.[!pi'] in
              incr pi';
              if !pi' + 1 < pn && pat.[!pi'] = '-' then begin
                let c2 = pat.[!pi' + 1] in
                pi' := !pi' + 2;
                if si < sn && str.[si] >= c1 && str.[si] <= c2 then matched := true
              end else if si < sn && str.[si] = c1 then matched := true
            done;
            if !pi' < pn then incr pi';
            ((!matched && not negate) || (not !matched && negate)) && go !pi' (si+1)
          | c -> si < sn && str.[si] = c && go (pi+1) (si+1)
      in go 0 0
    in
    let glob_paths pat =
      let dir = Filename.dirname pat in
      let base_pat = Filename.basename pat in
      let dir' = if dir = "." && not (String.length pat > 1 && pat.[0] = '.') then "." else dir in
      (try
        let entries = Sys.readdir dir' in
        Array.fold_left (fun acc entry ->
          if glob_match base_pat entry then
            let full = if dir' = "." then entry else Filename.concat dir' entry in
            full :: acc
          else acc
        ) [] entries
        |> List.sort String.compare
      with Sys_error _ -> [])
    in
    match args with
    | [String pat] -> List (List.map (fun s -> String s) (glob_paths pat))
    | _ -> raise (Eval_error "file-glob: (pattern)"));

  (* === File metadata + ops (Phase 5d) === *)
  let stat_or = function
    | String path -> (try Some (Unix.stat path) with _ -> None)
    | _ -> raise (Eval_error "file: path must be a string")
  in
  register "file-size" (fun args ->
    match args with
    | [v] -> (match stat_or v with Some s -> Integer s.Unix.st_size | None -> Integer 0)
    | _ -> raise (Eval_error "file-size: (path)"));
  register "file-mtime" (fun args ->
    match args with
    | [v] -> (match stat_or v with Some s -> Integer (int_of_float s.Unix.st_mtime) | None -> Integer 0)
    | _ -> raise (Eval_error "file-mtime: (path)"));
  register "file-isfile?" (fun args ->
    match args with
    | [v] -> (match stat_or v with Some s -> Bool (s.Unix.st_kind = Unix.S_REG) | None -> Bool false)
    | _ -> raise (Eval_error "file-isfile?: (path)"));
  register "file-isdir?" (fun args ->
    match args with
    | [v] -> (match stat_or v with Some s -> Bool (s.Unix.st_kind = Unix.S_DIR) | None -> Bool false)
    | _ -> raise (Eval_error "file-isdir?: (path)"));
  register "file-readable?" (fun args ->
    match args with
    | [String path] ->
      Bool (try Unix.access path [Unix.R_OK]; true with _ -> false)
    | _ -> raise (Eval_error "file-readable?: (path)"));
  register "file-writable?" (fun args ->
    match args with
    | [String path] ->
      Bool (try Unix.access path [Unix.W_OK]; true with _ -> false)
    | _ -> raise (Eval_error "file-writable?: (path)"));
  register "file-stat" (fun args ->
    match args with
    | [v] ->
      (match stat_or v with
       | None -> Nil
       | Some s ->
         let d = Hashtbl.create 6 in
         Hashtbl.replace d "size" (Integer s.Unix.st_size);
         Hashtbl.replace d "mtime" (Integer (int_of_float s.Unix.st_mtime));
         Hashtbl.replace d "atime" (Integer (int_of_float s.Unix.st_atime));
         Hashtbl.replace d "ctime" (Integer (int_of_float s.Unix.st_ctime));
         Hashtbl.replace d "mode" (Integer s.Unix.st_perm);
         Hashtbl.replace d "type" (String (match s.Unix.st_kind with
           | Unix.S_REG -> "file" | Unix.S_DIR -> "directory"
           | Unix.S_LNK -> "link" | Unix.S_CHR -> "characterSpecial"
           | Unix.S_BLK -> "blockSpecial" | Unix.S_FIFO -> "fifo"
           | Unix.S_SOCK -> "socket"));
         Dict d)
    | _ -> raise (Eval_error "file-stat: (path)"));
  register "file-delete" (fun args ->
    match args with
    | [String path] ->
      (try
        if Sys.is_directory path then Unix.rmdir path
        else Unix.unlink path
      with
      | Unix.Unix_error (Unix.ENOENT, _, _) -> ()  (* tolerate missing *)
      | Unix.Unix_error (e, _, _) -> raise (Eval_error ("file-delete: " ^ Unix.error_message e)));
      Nil
    | _ -> raise (Eval_error "file-delete: (path)"));
  register "file-mkdir" (fun args ->
    match args with
    | [String path] ->
      let rec mk p =
        if p = "" || p = "." || p = "/" then ()
        else if Sys.file_exists p then ()
        else begin
          mk (Filename.dirname p);
          (try Unix.mkdir p 0o755
           with Unix.Unix_error (Unix.EEXIST, _, _) -> ())
        end
      in
      (try mk path
       with Unix.Unix_error (e, _, _) -> raise (Eval_error ("file-mkdir: " ^ Unix.error_message e)));
      Nil
    | _ -> raise (Eval_error "file-mkdir: (path)"));
  register "file-copy" (fun args ->
    match args with
    | [String src; String dst] ->
      (try
        let ic = open_in_bin src in
        let oc = open_out_bin dst in
        let buf = Bytes.create 8192 in
        let rec loop () =
          let n = input ic buf 0 (Bytes.length buf) in
          if n > 0 then (output oc buf 0 n; loop ())
        in
        loop ();
        close_in ic;
        close_out oc;
        Nil
      with
      | Sys_error msg -> raise (Eval_error ("file-copy: " ^ msg)))
    | _ -> raise (Eval_error "file-copy: (src dst)"));
  register "file-rename" (fun args ->
    match args with
    | [String src; String dst] ->
      (try Sys.rename src dst with Sys_error msg -> raise (Eval_error ("file-rename: " ^ msg)));
      Nil
    | _ -> raise (Eval_error "file-rename: (src dst)"));

  (* === Channels (random-access + blocking control) === *)
  let channel_table : (string, Unix.file_descr * string * bool ref * bool ref) Hashtbl.t = Hashtbl.create 16 in
  let channel_next_id = ref 0 in
  let parse_open_mode mode =
    match mode with
    | "r"  -> [Unix.O_RDONLY]
    | "w"  -> [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC]
    | "a"  -> [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND]
    | "r+" -> [Unix.O_RDWR]
    | "w+" -> [Unix.O_RDWR; Unix.O_CREAT; Unix.O_TRUNC]
    | "a+" -> [Unix.O_RDWR; Unix.O_CREAT; Unix.O_APPEND]
    | _ -> raise (Eval_error ("channel-open: invalid mode " ^ mode))
  in
  let chan_get name =
    match Hashtbl.find_opt channel_table name with
    | Some c -> c
    | None -> raise (Eval_error ("channel: no such channel " ^ name))
  in
  register "channel-open" (fun args ->
    match args with
    | [String path; String mode] ->
      (try
        let fd = Unix.openfile path (parse_open_mode mode) 0o644 in
        let id = !channel_next_id in
        incr channel_next_id;
        let name = Printf.sprintf "file%d" id in
        Hashtbl.replace channel_table name (fd, mode, ref false, ref true);
        String name
      with Unix.Unix_error (e, _, _) -> raise (Eval_error ("channel-open: " ^ Unix.error_message e)))
    | _ -> raise (Eval_error "channel-open: (path mode)"));

  register "channel-close" (fun args ->
    match args with
    | [String name] ->
      let (fd, _, _, _) = chan_get name in
      (try Unix.close fd with _ -> ());
      Hashtbl.remove channel_table name;
      Nil
    | _ -> raise (Eval_error "channel-close: (channel)"));

  register "channel-read" (fun args ->
    let (name, max_n) = match args with
      | [String n] -> (n, -1)
      | [String n; Integer m] -> (n, m)
      | [String n; Number m] -> (n, int_of_float m)
      | _ -> raise (Eval_error "channel-read: (channel ?n?)")
    in
    let (fd, _, eof, _) = chan_get name in
    let chunk = 8192 in
    let buf = Bytes.create chunk in
    let buffer = Buffer.create chunk in
    let total = ref 0 in
    let stop = ref false in
    while not !stop do
      let want = if max_n < 0 then chunk else min chunk (max_n - !total) in
      if want <= 0 then stop := true
      else begin
        try
          let r = Unix.read fd buf 0 want in
          if r = 0 then begin eof := true; stop := true end
          else begin
            Buffer.add_subbytes buffer buf 0 r;
            total := !total + r
          end
        with
        | Unix.Unix_error (Unix.EAGAIN, _, _)
        | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) -> stop := true
      end
    done;
    String (Buffer.contents buffer));

  register "channel-read-line" (fun args ->
    match args with
    | [String name] ->
      let (fd, _, eof, _) = chan_get name in
      let buf = Buffer.create 80 in
      let one = Bytes.create 1 in
      let got_data = ref false in
      let stop = ref false in
      while not !stop do
        try
          let r = Unix.read fd one 0 1 in
          if r = 0 then begin eof := true; stop := true end
          else begin
            got_data := true;
            let c = Bytes.get one 0 in
            if c = '\n' then stop := true
            else Buffer.add_char buf c
          end
        with
        | Unix.Unix_error (Unix.EAGAIN, _, _)
        | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) -> stop := true
      done;
      if !got_data then String (Buffer.contents buf) else Nil
    | _ -> raise (Eval_error "channel-read-line: (channel)"));

  register "channel-write" (fun args ->
    match args with
    | [String name; String s] ->
      let (fd, _, _, _) = chan_get name in
      let b = Bytes.of_string s in
      let n = Bytes.length b in
      let written = ref 0 in
      while !written < n do
        (try
          let w = Unix.write fd b !written (n - !written) in
          written := !written + w
        with
        | Unix.Unix_error (Unix.EAGAIN, _, _)
        | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) ->
          (* short write — let caller retry *)
          written := n)
      done;
      Nil
    | _ -> raise (Eval_error "channel-write: (channel string)"));

  register "channel-flush" (fun args ->
    match args with
    | [String name] -> let _ = chan_get name in Nil  (* no userspace buffer *)
    | _ -> raise (Eval_error "channel-flush: (channel)"));

  register "channel-seek" (fun args ->
    let (name, offset, whence) = match args with
      | [String n; Integer o] -> (n, o, "start")
      | [String n; Number o] -> (n, int_of_float o, "start")
      | [String n; Integer o; String w] -> (n, o, w)
      | [String n; Number o; String w] -> (n, int_of_float o, w)
      | _ -> raise (Eval_error "channel-seek: (channel offset ?whence?)")
    in
    let (fd, _, eof, _) = chan_get name in
    let cmd = match whence with
      | "start" -> Unix.SEEK_SET
      | "current" -> Unix.SEEK_CUR
      | "end" -> Unix.SEEK_END
      | _ -> raise (Eval_error ("channel-seek: invalid whence " ^ whence))
    in
    let _ = Unix.lseek fd offset cmd in
    eof := false;
    Nil);

  register "channel-tell" (fun args ->
    match args with
    | [String name] ->
      let (fd, _, _, _) = chan_get name in
      Integer (Unix.lseek fd 0 Unix.SEEK_CUR)
    | _ -> raise (Eval_error "channel-tell: (channel)"));

  register "channel-eof?" (fun args ->
    match args with
    | [String name] ->
      let (_, _, eof, _) = chan_get name in
      Bool !eof
    | _ -> raise (Eval_error "channel-eof?: (channel)"));

  register "channel-blocking?" (fun args ->
    match args with
    | [String name] ->
      let (_, _, _, blocking) = chan_get name in
      Bool !blocking
    | _ -> raise (Eval_error "channel-blocking?: (channel)"));

  register "channel-set-blocking!" (fun args ->
    match args with
    | [String name; Bool b] ->
      let (fd, _, _, blocking) = chan_get name in
      blocking := b;
      (try
        if b then Unix.clear_nonblock fd
        else Unix.set_nonblock fd
      with _ -> ());
      Nil
    | _ -> raise (Eval_error "channel-set-blocking!: (channel bool)"));

  (* === Exec === run an external process; capture stdout *)
  register "exec-process" (fun args ->
    let items = match args with
      | [List xs] | [ListRef { contents = xs }] -> xs
      | _ -> raise (Eval_error "exec-process: (cmd-list)")
    in
    let argv = Array.of_list (List.map (function
      | String s -> s
      | v -> Sx_types.inspect v
    ) items) in
    if Array.length argv = 0 then raise (Eval_error "exec: empty command");
    let (out_r, out_w) = Unix.pipe () in
    let (err_r, err_w) = Unix.pipe () in
    let pid =
      try Unix.create_process argv.(0) argv Unix.stdin out_w err_w
      with Unix.Unix_error (e, _, _) ->
        Unix.close out_r; Unix.close out_w;
        Unix.close err_r; Unix.close err_w;
        raise (Eval_error ("exec: " ^ Unix.error_message e))
    in
    Unix.close out_w;
    Unix.close err_w;
    let buf = Buffer.create 256 in
    let errbuf = Buffer.create 64 in
    let chunk = Bytes.create 4096 in
    let read_all fd target =
      try
        let stop = ref false in
        while not !stop do
          let n = Unix.read fd chunk 0 (Bytes.length chunk) in
          if n = 0 then stop := true
          else Buffer.add_subbytes target chunk 0 n
        done
      with _ -> ()
    in
    read_all out_r buf;
    read_all err_r errbuf;
    Unix.close out_r;
    Unix.close err_r;
    let (_, status) = Unix.waitpid [] pid in
    let exit_code = match status with
      | Unix.WEXITED n -> n
      | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> 1
    in
    let s = Buffer.contents buf in
    let trimmed =
      if String.length s > 0 && s.[String.length s - 1] = '\n'
      then String.sub s 0 (String.length s - 1) else s
    in
    if exit_code <> 0 then
      raise (Eval_error ("exec: child exited " ^ string_of_int exit_code
                         ^ (if Buffer.length errbuf > 0
                            then ": " ^ Buffer.contents errbuf
                            else "")))
    else String trimmed);

  (* exec-pipeline: takes a list of words like Tcl `exec` would receive.
     Recognizes `|` as a stage separator and `> file`, `>> file`, `< file`,
     `2>@1` (stderr→stdout), `2> file`. Returns trimmed stdout of the last
     stage; raises Eval_error if the last stage exits non-zero. *)
  register "exec-pipeline" (fun args ->
    let items = match args with
      | [List xs] | [ListRef { contents = xs }] -> xs
      | _ -> raise (Eval_error "exec-pipeline: (word-list)")
    in
    let words = List.map (function
      | String s -> s
      | v -> Sx_types.inspect v
    ) items in
    if words = [] then raise (Eval_error "exec: empty command");
    let split_stages ws =
      let rec loop acc cur = function
        | [] -> List.rev (List.rev cur :: acc)
        | "|" :: rest -> loop (List.rev cur :: acc) [] rest
        | w :: rest -> loop acc (w :: cur) rest
      in
      loop [] [] ws
    in
    let extract_redirs ws =
      let in_path = ref None in
      let out_path = ref None in
      let out_append = ref false in
      let err_path = ref None in
      let merge_err = ref false in
      let cleaned = ref [] in
      let rec loop = function
        | [] -> ()
        | "<" :: p :: rest -> in_path := Some p; loop rest
        | ">" :: p :: rest -> out_path := Some p; out_append := false; loop rest
        | ">>" :: p :: rest -> out_path := Some p; out_append := true; loop rest
        | "2>@1" :: rest -> merge_err := true; loop rest
        | "2>" :: p :: rest -> err_path := Some p; loop rest
        | w :: rest -> cleaned := w :: !cleaned; loop rest
      in
      loop ws;
      (List.rev !cleaned, !in_path, !out_path, !out_append, !err_path, !merge_err)
    in
    let stages = List.map extract_redirs (split_stages words) in
    if stages = [] then raise (Eval_error "exec: no stages");
    let n = List.length stages in
    let pipes = Array.init (max 0 (n - 1)) (fun _ -> Unix.pipe ()) in
    let (final_r, final_w) = Unix.pipe () in
    let (errstash_r, errstash_w) = Unix.pipe () in
    let pids = ref [] in
    let close_safe fd = try Unix.close fd with _ -> () in
    let open_in_redir = function
      | None -> Unix.stdin
      | Some path ->
        (try Unix.openfile path [Unix.O_RDONLY] 0o644
         with Unix.Unix_error (e, _, _) ->
           raise (Eval_error ("exec: open <" ^ path ^ ": " ^ Unix.error_message e)))
    in
    let open_out_redir path append =
      let flags = Unix.O_WRONLY :: Unix.O_CREAT :: (if append then [Unix.O_APPEND] else [Unix.O_TRUNC]) in
      try Unix.openfile path flags 0o644
      with Unix.Unix_error (e, _, _) ->
        raise (Eval_error ("exec: open >" ^ path ^ ": " ^ Unix.error_message e))
    in
    let stages_arr = Array.of_list stages in
    (try
      Array.iteri (fun i (cleaned, ip, op, app, ep, merge) ->
        if cleaned = [] then raise (Eval_error "exec: empty stage in pipeline");
        let argv = Array.of_list cleaned in
        let stdin_fd =
          if i = 0 then open_in_redir ip
          else fst pipes.(i - 1)
        in
        let stdout_fd =
          if i = n - 1 then
            (match op with
             | None -> final_w
             | Some path -> open_out_redir path app)
          else snd pipes.(i)
        in
        let stderr_fd =
          if merge then stdout_fd
          else (match ep with
                | None -> if i = n - 1 then errstash_w else Unix.stderr
                | Some path -> open_out_redir path false)
        in
        let pid =
          try Unix.create_process argv.(0) argv stdin_fd stdout_fd stderr_fd
          with Unix.Unix_error (e, _, _) ->
            raise (Eval_error ("exec: " ^ argv.(0) ^ ": " ^ Unix.error_message e))
        in
        pids := pid :: !pids;
        if i > 0 then close_safe (fst pipes.(i - 1));
        if i < n - 1 then close_safe (snd pipes.(i));
        if i = 0 && ip <> None then close_safe stdin_fd;
        if i = n - 1 && op <> None then close_safe stdout_fd;
        if not merge && ep <> None then close_safe stderr_fd
      ) stages_arr
    with e ->
      close_safe final_r; close_safe final_w;
      close_safe errstash_r; close_safe errstash_w;
      Array.iter (fun (a,b) -> close_safe a; close_safe b) pipes;
      raise e);
    close_safe final_w;
    close_safe errstash_w;
    let buf = Buffer.create 256 in
    let errbuf = Buffer.create 64 in
    let chunk = Bytes.create 4096 in
    let read_all fd target =
      try
        let stop = ref false in
        while not !stop do
          let r = Unix.read fd chunk 0 (Bytes.length chunk) in
          if r = 0 then stop := true
          else Buffer.add_subbytes target chunk 0 r
        done
      with _ -> ()
    in
    read_all final_r buf;
    read_all errstash_r errbuf;
    close_safe final_r;
    close_safe errstash_r;
    let exit_codes = List.rev_map (fun pid ->
      let (_, st) = Unix.waitpid [] pid in
      match st with
      | Unix.WEXITED c -> c
      | _ -> 1
    ) !pids in
    let final_code = match List.rev exit_codes with
      | [] -> 0
      | last :: _ -> last
    in
    let s = Buffer.contents buf in
    let trimmed =
      if String.length s > 0 && s.[String.length s - 1] = '\n'
      then String.sub s 0 (String.length s - 1) else s
    in
    if final_code <> 0 then
      raise (Eval_error ("exec: pipeline last stage exited " ^ string_of_int final_code
                         ^ (if Buffer.length errbuf > 0
                            then ": " ^ Buffer.contents errbuf
                            else "")))
    else String trimmed);

  (* === Sockets === wrapping Unix.socket/connect/bind/listen/accept *)
  let resolve_inet_addr host =
    if host = "" || host = "0.0.0.0" then Unix.inet_addr_any
    else if host = "localhost" then Unix.inet_addr_loopback
    else
      try Unix.inet_addr_of_string host
      with _ ->
        try
          let entry = Unix.gethostbyname host in
          if Array.length entry.Unix.h_addr_list = 0 then
            raise (Eval_error ("socket: cannot resolve " ^ host))
          else entry.Unix.h_addr_list.(0)
        with Not_found -> raise (Eval_error ("socket: cannot resolve " ^ host))
  in
  let port_of v = match v with
    | Integer n -> n
    | Number n -> int_of_float n
    | _ -> raise (Eval_error "socket: port must be a number")
  in
  let alloc_chan_name () =
    let id = !channel_next_id in
    incr channel_next_id;
    Printf.sprintf "sock%d" id
  in

  register "socket-connect" (fun args ->
    match args with
    | [String host; port_v] ->
      let port = port_of port_v in
      let addr = Unix.ADDR_INET (resolve_inet_addr host, port) in
      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
      (try Unix.connect sock addr
       with Unix.Unix_error (e, _, _) ->
         (try Unix.close sock with _ -> ());
         raise (Eval_error ("socket-connect: " ^ Unix.error_message e)));
      let name = alloc_chan_name () in
      Hashtbl.replace channel_table name (sock, "rw", ref false, ref true);
      String name
    | _ -> raise (Eval_error "socket-connect: (host port)"));

  (* Non-blocking connect: returns channel immediately. Connection completes
     when the channel becomes writable; query channel-async-error? after to
     confirm success or get the error. *)
  register "socket-connect-async" (fun args ->
    match args with
    | [String host; port_v] ->
      let port = port_of port_v in
      let addr = Unix.ADDR_INET (resolve_inet_addr host, port) in
      let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
      Unix.set_nonblock sock;
      (try Unix.connect sock addr
       with
       | Unix.Unix_error (Unix.EINPROGRESS, _, _)
       | Unix.Unix_error (Unix.EWOULDBLOCK, _, _) -> ()
       | Unix.Unix_error (e, _, _) ->
         (try Unix.close sock with _ -> ());
         raise (Eval_error ("socket-connect-async: " ^ Unix.error_message e)));
      let name = alloc_chan_name () in
      Hashtbl.replace channel_table name (sock, "rw", ref false, ref false);
      String name
    | _ -> raise (Eval_error "socket-connect-async: (host port)"));

  (* After a non-blocking connect completes (channel writable), check whether
     the connect succeeded. Returns "" on success, error message on failure. *)
  register "channel-async-error" (fun args ->
    match args with
    | [String name] ->
      let (fd, _, _, _) = chan_get name in
      (try
        let err = Unix.getsockopt_error fd in
        match err with
        | None -> String ""
        | Some e -> String (Unix.error_message e)
      with
      | Unix.Unix_error (e, _, _) -> String (Unix.error_message e))
    | _ -> raise (Eval_error "channel-async-error: (channel)"));

  register "socket-server" (fun args ->
    let (host, port) = match args with
      | [port_v] -> ("", port_of port_v)
      | [String h; port_v] -> (h, port_of port_v)
      | _ -> raise (Eval_error "socket-server: (port) or (host port)")
    in
    let addr = Unix.ADDR_INET (resolve_inet_addr host, port) in
    let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
    Unix.setsockopt sock Unix.SO_REUSEADDR true;
    (try Unix.bind sock addr
     with Unix.Unix_error (e, _, _) ->
       (try Unix.close sock with _ -> ());
       raise (Eval_error ("socket-server: bind: " ^ Unix.error_message e)));
    Unix.listen sock 8;
    let name = alloc_chan_name () in
    Hashtbl.replace channel_table name (sock, "server", ref false, ref true);
    String name);

  register "socket-accept" (fun args ->
    match args with
    | [String name] ->
      let (sock, _, _, _) = chan_get name in
      let (client_sock, client_addr) =
        try Unix.accept sock
        with Unix.Unix_error (e, _, _) ->
          raise (Eval_error ("socket-accept: " ^ Unix.error_message e))
      in
      let (host_str, port) = match client_addr with
        | Unix.ADDR_INET (addr, p) -> (Unix.string_of_inet_addr addr, p)
        | Unix.ADDR_UNIX path -> (path, 0)
      in
      let client_name = alloc_chan_name () in
      Hashtbl.replace channel_table client_name (client_sock, "rw", ref false, ref true);
      let d = Hashtbl.create 3 in
      Hashtbl.replace d "channel" (String client_name);
      Hashtbl.replace d "host" (String host_str);
      Hashtbl.replace d "port" (Integer port);
      Dict d
    | _ -> raise (Eval_error "socket-accept: (server-channel)"));

  (* io-select-channels: (read-list write-list timeout-ms) → {:readable [...] :writable [...]}
     timeout-ms < 0 → block indefinitely; 0 → poll. Returns ready channel names. *)
  register "io-select-channels" (fun args ->
    let to_ms v = match v with
      | Integer n -> n
      | Number n -> int_of_float n
      | _ -> raise (Eval_error "io-select-channels: timeout must be a number")
    in
    let to_list v = match v with
      | List xs | ListRef { contents = xs } -> xs
      | Nil -> []
      | _ -> raise (Eval_error "io-select-channels: expected list")
    in
    let chan_name_of v = match v with
      | String s -> s
      | _ -> raise (Eval_error "io-select-channels: channel must be a string")
    in
    let (read_list, write_list, timeout_ms) = match args with
      | [r; w; t] -> (to_list r, to_list w, to_ms t)
      | _ -> raise (Eval_error "io-select-channels: (read-list write-list timeout-ms)")
    in
    let read_pairs = List.map (fun v ->
      let name = chan_name_of v in
      let (fd, _, _, _) = chan_get name in (name, fd)) read_list in
    let write_pairs = List.map (fun v ->
      let name = chan_name_of v in
      let (fd, _, _, _) = chan_get name in (name, fd)) write_list in
    let read_fds = List.map snd read_pairs in
    let write_fds = List.map snd write_pairs in
    let timeout = if timeout_ms < 0 then -1.0 else float_of_int timeout_ms /. 1000.0 in
    let (ready_r, ready_w, _) =
      try Unix.select read_fds write_fds [] timeout
      with Unix.Unix_error (Unix.EINTR, _, _) -> ([], [], [])
    in
    let names_of pairs ready =
      List.filter_map (fun (n, fd) ->
        if List.exists (fun rfd -> rfd = fd) ready then Some (String n) else None
      ) pairs
    in
    let d = Hashtbl.create 2 in
    Hashtbl.replace d "readable" (List (names_of read_pairs ready_r));
    Hashtbl.replace d "writable" (List (names_of write_pairs ready_w));
    Dict d);

  (* === Clock === *)
  register "clock-seconds" (fun args ->
    match args with
    | [] -> Integer (int_of_float (Unix.gettimeofday ()))
    | _ -> raise (Eval_error "clock-seconds: no args"));

  register "clock-milliseconds" (fun args ->
    match args with
    | [] -> Integer (int_of_float (Unix.gettimeofday () *. 1000.0))
    | _ -> raise (Eval_error "clock-milliseconds: no args"));

  let format_tm tm tz_label =
    fun fmt ->
      let buf = Buffer.create 32 in
      let n = String.length fmt in
      let i = ref 0 in
      while !i < n do
        if fmt.[!i] = '%' && !i + 1 < n then begin
          (match fmt.[!i + 1] with
           | 'Y' -> Buffer.add_string buf (Printf.sprintf "%04d" (1900 + tm.Unix.tm_year))
           | 'y' -> Buffer.add_string buf (Printf.sprintf "%02d" ((1900 + tm.Unix.tm_year) mod 100))
           | 'm' -> Buffer.add_string buf (Printf.sprintf "%02d" (tm.Unix.tm_mon + 1))
           | 'd' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_mday)
           | 'e' -> Buffer.add_string buf (Printf.sprintf "%2d"  tm.Unix.tm_mday)
           | 'H' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_hour)
           | 'I' -> let h = tm.Unix.tm_hour mod 12 in
                    Buffer.add_string buf (Printf.sprintf "%02d" (if h = 0 then 12 else h))
           | 'p' -> Buffer.add_string buf (if tm.Unix.tm_hour < 12 then "AM" else "PM")
           | 'M' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_min)
           | 'S' -> Buffer.add_string buf (Printf.sprintf "%02d" tm.Unix.tm_sec)
           | 'j' -> Buffer.add_string buf (Printf.sprintf "%03d" (tm.Unix.tm_yday + 1))
           | 'w' -> Buffer.add_string buf (string_of_int tm.Unix.tm_wday)
           | 'Z' -> Buffer.add_string buf tz_label
           | 'a' -> let days = [|"Sun";"Mon";"Tue";"Wed";"Thu";"Fri";"Sat"|] in
                    Buffer.add_string buf days.(tm.Unix.tm_wday)
           | 'A' -> let days = [|"Sunday";"Monday";"Tuesday";"Wednesday";"Thursday";"Friday";"Saturday"|] in
                    Buffer.add_string buf days.(tm.Unix.tm_wday)
           | 'b' | 'h' -> let mons = [|"Jan";"Feb";"Mar";"Apr";"May";"Jun";"Jul";"Aug";"Sep";"Oct";"Nov";"Dec"|] in
                    Buffer.add_string buf mons.(tm.Unix.tm_mon)
           | 'B' -> let mons = [|"January";"February";"March";"April";"May";"June";"July";"August";"September";"October";"November";"December"|] in
                    Buffer.add_string buf mons.(tm.Unix.tm_mon)
           | '%' -> Buffer.add_char buf '%'
           | c -> Buffer.add_char buf '%'; Buffer.add_char buf c);
          i := !i + 2
        end else begin
          Buffer.add_char buf fmt.[!i];
          incr i
        end
      done;
      Buffer.contents buf
  in
  register "clock-format" (fun args ->
    let (t, fmt, tz) = match args with
      | [Integer t] -> (t, "%a %b %e %H:%M:%S %Z %Y", "utc")
      | [Integer t; String f] -> (t, f, "utc")
      | [Integer t; String f; String z] -> (t, f, z)
      | _ -> raise (Eval_error "clock-format: (seconds [format [tz]])")
    in
    let tm =
      if tz = "local" then Unix.localtime (float_of_int t)
      else Unix.gmtime (float_of_int t)
    in
    let label = if tz = "local" then "" else "UTC" in
    String (format_tm tm label fmt));

  (* clock-scan: parse a date string with format, return seconds.
     Supports the same format specifiers as clock-format (fixed-width ones).
     tz: "utc" (default) or "local". *)
  let timegm (tm : Unix.tm) =
    let is_leap y = y mod 4 = 0 && (y mod 100 <> 0 || y mod 400 = 0) in
    let days_in_month = [|31;28;31;30;31;30;31;31;30;31;30;31|] in
    let year = tm.Unix.tm_year + 1900 in
    let mon = tm.Unix.tm_mon in
    let mday = tm.Unix.tm_mday in
    let total_days = ref 0 in
    if year >= 1970 then begin
      for y = 1970 to year - 1 do
        total_days := !total_days + (if is_leap y then 366 else 365)
      done
    end else begin
      for y = year to 1969 do
        total_days := !total_days - (if is_leap y then 366 else 365)
      done
    end;
    for m = 0 to mon - 1 do
      total_days := !total_days + days_in_month.(m);
      if m = 1 && is_leap year then incr total_days
    done;
    total_days := !total_days + mday - 1;
    !total_days * 86400
    + tm.Unix.tm_hour * 3600
    + tm.Unix.tm_min * 60
    + tm.Unix.tm_sec
  in
  register "clock-scan" (fun args ->
    let (str, fmt, tz) = match args with
      | [String s; String f] -> (s, f, "utc")
      | [String s; String f; String z] -> (s, f, z)
      | _ -> raise (Eval_error "clock-scan: (str fmt [tz])")
    in
    let n = String.length fmt and sn = String.length str in
    let tm = ref { Unix.tm_year = 70; tm_mon = 0; tm_mday = 1;
                   tm_hour = 0; tm_min = 0; tm_sec = 0;
                   tm_wday = 0; tm_yday = 0; tm_isdst = false } in
    let i = ref 0 and j = ref 0 in
    let read_n_digits k =
      let s = ref "" in
      let cnt = ref 0 in
      while !cnt < k && !j < sn && str.[!j] >= '0' && str.[!j] <= '9' do
        s := !s ^ String.make 1 str.[!j];
        incr j; incr cnt
      done;
      if !s = "" then 0 else int_of_string !s
    in
    let skip_ws () =
      while !j < sn && (str.[!j] = ' ' || str.[!j] = '\t') do incr j done
    in
    while !i < n do
      if fmt.[!i] = '%' && !i + 1 < n then begin
        (match fmt.[!i + 1] with
         | 'Y' -> tm := { !tm with tm_year = read_n_digits 4 - 1900 }
         | 'y' -> let y = read_n_digits 2 in
                  tm := { !tm with tm_year = (if y < 70 then 100 + y else y) }
         | 'm' -> tm := { !tm with tm_mon = read_n_digits 2 - 1 }
         | 'd' | 'e' -> skip_ws (); tm := { !tm with tm_mday = read_n_digits 2 }
         | 'H' | 'I' -> tm := { !tm with tm_hour = read_n_digits 2 }
         | 'M' -> tm := { !tm with tm_min = read_n_digits 2 }
         | 'S' -> tm := { !tm with tm_sec = read_n_digits 2 }
         | '%' -> if !j < sn && str.[!j] = '%' then incr j
         | _ -> ()  (* unsupported specifier — skip *)
        );
        i := !i + 2
      end else begin
        if fmt.[!i] = ' ' then skip_ws ()
        else if !j < sn && str.[!j] = fmt.[!i] then incr j;
        incr i
      end
    done;
    let secs =
      if tz = "local" then int_of_float (fst (Unix.mktime !tm))
      else timegm !tm
    in
    Integer secs);

  (* === Env-as-value (Phase 4) === *)

  (* env-lookup: (env key) → value or nil.  Works on Env, Dict, or Nil. *)
  register "env-lookup" (fun args ->
    let unwrap = function
      | Env e -> e
      | Nil -> make_env ()
      | _ -> raise (Eval_error "env-lookup: first arg must be an environment") in
    match args with
    | [env_val; key] ->
      let e = unwrap env_val in
      let k = value_to_string key in
      if env_has e k then env_get e k else Nil
    | _ -> raise (Eval_error "env-lookup: (env key)"));

  (* env-extend: (env [key val ...]) → new child env with optional bindings. *)
  register "env-extend" (fun args ->
    match args with
    | [] -> raise (Eval_error "env-extend: requires at least one arg")
    | env_val :: pairs ->
      let parent_env = match env_val with
        | Env e -> e
        | Nil -> make_env ()
        | _ -> raise (Eval_error "env-extend: first arg must be an environment") in
      let child = env_extend parent_env in
      let rec add_bindings = function
        | [] -> ()
        | k :: v :: rest -> ignore (env_bind child (value_to_string k) v); add_bindings rest
        | [_] -> raise (Eval_error "env-extend: odd number of key-val pairs") in
      add_bindings pairs;
      Env child);

  (* JIT cache control & observability — backed by refs in sx_types.ml to
     avoid creating a sx_primitives → sx_vm dependency cycle. sx_vm reads
     these refs to decide when to JIT. *)
  register "jit-stats" (fun _args ->
    let d = Hashtbl.create 8 in
    Hashtbl.replace d "threshold"        (Number (float_of_int !Sx_types.jit_threshold));
    Hashtbl.replace d "budget"           (Number (float_of_int !Sx_types.jit_budget));
    Hashtbl.replace d "cache-size"       (Number (float_of_int (Sx_types.jit_cache_size ())));
    Hashtbl.replace d "compiled"         (Number (float_of_int !Sx_types.jit_compiled_count));
    Hashtbl.replace d "compile-failed"   (Number (float_of_int !Sx_types.jit_skipped_count));
    Hashtbl.replace d "below-threshold"  (Number (float_of_int !Sx_types.jit_threshold_skipped_count));
    Hashtbl.replace d "evicted"          (Number (float_of_int !Sx_types.jit_evicted_count));
    Dict d);
  register "jit-set-threshold!" (fun args ->
    match args with
    | [Number n] -> Sx_types.jit_threshold := int_of_float n; Nil
    | [Integer n] -> Sx_types.jit_threshold := n; Nil
    | _ -> raise (Eval_error "jit-set-threshold!: (n) where n is integer"));
  register "jit-set-budget!" (fun args ->
    match args with
    | [Number n] -> Sx_types.jit_budget := int_of_float n; Nil
    | [Integer n] -> Sx_types.jit_budget := n; Nil
    | _ -> raise (Eval_error "jit-set-budget!: (n) where n is integer"));
  register "jit-reset-cache!" (fun _args ->
    (* Phase 3 manual cache reset — clear all compiled VmClosures.
       Hot paths will re-JIT on next call (after re-hitting threshold). *)
    Queue.iter (fun (_, v) ->
      match v with Lambda l -> l.l_compiled <- None | _ -> ()
    ) Sx_types.jit_cache_queue;
    Queue.clear Sx_types.jit_cache_queue;
    Nil);
  register "jit-reset-counters!" (fun _args ->
    Sx_types.jit_compiled_count := 0;
    Sx_types.jit_skipped_count := 0;
    Sx_types.jit_threshold_skipped_count := 0;
    Sx_types.jit_evicted_count := 0;
    Nil);

  (* fed-sx host primitives — pure-OCaml crypto (WASM-safe). *)
  register "crypto-sha256" (fun args ->
    match args with
    | [String s] -> String (Sx_sha2.sha256_hex s)
    | _ -> raise (Eval_error "crypto-sha256: (bytes)"));

  register "crypto-sha512" (fun args ->
    match args with
    | [String s] -> String (Sx_sha2.sha512_hex s)
    | _ -> raise (Eval_error "crypto-sha512: (bytes)"));

  register "crypto-sha3-256" (fun args ->
    match args with
    | [String s] -> String (Sx_sha3.sha3_256_hex s)
    | _ -> raise (Eval_error "crypto-sha3-256: (bytes)"));

  register "cbor-encode" (fun args ->
    match args with
    | [v] ->
      (try String (Sx_cbor.encode v)
       with Sx_cbor.Cbor_error m -> raise (Eval_error m))
    | _ -> raise (Eval_error "cbor-encode: (value)"));

  register "cbor-decode" (fun args ->
    match args with
    | [String s] ->
      (try Sx_cbor.decode s
       with Sx_cbor.Cbor_error m -> raise (Eval_error m))
    | _ -> raise (Eval_error "cbor-decode: (bytes)"));

  register "cid-from-bytes" (fun args ->
    match args with
    | [Integer codec; String mh] ->
      String (Sx_cid.cidv1 codec mh)
    | _ -> raise (Eval_error "cid-from-bytes: (codec multihash-bytes)"));

  register "cid-from-sx" (fun args ->
    match args with
    | [v] ->
      (try String (Sx_cid.cid_from_sx v)
       with Sx_cbor.Cbor_error m -> raise (Eval_error m))
    | _ -> raise (Eval_error "cid-from-sx: (value)"));

  (* Verify is total: any malformed input -> false, never raises. *)
  register "ed25519-verify" (fun args ->
    match args with
    | [String pk; String msg; String sg] ->
      Bool (try Sx_ed25519.verify ~pubkey:pk ~msg ~sig_:sg
            with _ -> false)
    | _ -> Bool false);

  register "rsa-sha256-verify" (fun args ->
    match args with
    | [String spki; String msg; String sg] ->
      Bool (try Sx_rsa.verify ~spki ~msg ~sig_:sg with _ -> false)
    | _ -> Bool false)
