rose-ash/hosts/ocaml/lib/sx_primitives.ml

(** 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 rec as_number = function
  | Number n -> n
  | 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
  | Number n ->
    if Float.is_integer n then string_of_int (int_of_float n)
    else Printf.sprintf "%g" 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 () =
  (* === Arithmetic === *)
  register "+" (fun args ->
    Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args));
  register "-" (fun args ->
    match args with
    | [] -> Number 0.0
    | [a] -> Number (-. (as_number a))
    | a :: rest -> Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest));
  register "*" (fun args ->
    Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
  register "/" (fun args ->
    match args with
    | [a; b] -> Number (as_number a /. as_number b)
    | _ -> raise (Eval_error "/: expected 2 args"));
  register "mod" (fun args ->
    match args with
    | [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 [a] -> Number (as_number a +. 1.0) | _ -> raise (Eval_error "inc: 1 arg"));
  register "dec" (fun args ->
    match args with [a] -> Number (as_number a -. 1.0) | _ -> raise (Eval_error "dec: 1 arg"));
  register "abs" (fun args ->
    match args with [a] -> Number (Float.abs (as_number a)) | _ -> raise (Eval_error "abs: 1 arg"));
  register "floor" (fun args ->
    match args with [a] -> Number (floor (as_number a))
    | _ -> raise (Eval_error "floor: 1 arg"));
  register "ceil" (fun args ->
    match args with [a] -> Number (ceil (as_number a))
    | _ -> raise (Eval_error "ceil: 1 arg"));
  register "round" (fun args ->
    match args with
    | [a] -> Number (Float.round (as_number a))
    | [a; b] ->
      let n = as_number a and places = int_of_float (as_number 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")
    | _ -> 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")
    | _ -> 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 "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
    | [a] -> let n = as_number a in Number (if n >= 0.0 then floor n else ceil n)
    | _ -> raise (Eval_error "truncate: 1 arg"));
  register "remainder" (fun args ->
    match args with
    | [a; b] -> Number (Float.rem (as_number a) (as_number b))
    | _ -> raise (Eval_error "remainder: 2 args"));
  register "modulo" (fun args ->
    match args with
    | [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 [Number f] -> Bool (Float.is_integer f) | [_] -> Bool false
    | _ -> raise (Eval_error "exact?: 1 arg"));
  register "inexact?" (fun args ->
    match args with [Number f] -> Bool (not (Float.is_integer f)) | [_] -> Bool false
    | _ -> raise (Eval_error "inexact?: 1 arg"));
  register "exact->inexact" (fun args ->
    match args with [Number n] -> Number n | [a] -> Number (as_number a)
    | _ -> raise (Eval_error "exact->inexact: 1 arg"));
  register "inexact->exact" (fun args ->
    match args with
    | [Number n] -> if Float.is_integer n then Number n else Number (Float.round n)
    | [a] -> Number (Float.round (as_number a))
    | _ -> raise (Eval_error "inexact->exact: 1 arg"));
  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 -> Number (float_of_int n) | None -> Nil)
    | [String s; default_val] ->
      (match parse_leading_int s with Some n -> Number (float_of_int n) | None -> default_val)
    | [Number n] | [Number n; _] -> Number (float_of_int (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
    | Number x, Number y -> x = 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
    | (List la | ListRef { contents = la }),
      (List lb | ListRef { contents = lb }) ->
      List.length la = List.length lb &&
      List.for_all2 safe_eq la lb
    (* Dict: check __host_handle for DOM node identity *)
    | 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)
    (* 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 [Number _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "number?: 1 arg"));
  register "integer?" (fun args ->
    match args with [Number f] -> Bool (Float.is_integer f) | [_] -> Bool false | _ -> raise (Eval_error "integer?: 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 | [_] -> Bool false | _ -> raise (Eval_error "dict?: 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] -> Number (float_of_int (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)
    | _ -> raise (Eval_error "starts-with?: 2 string args"));
  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)
    | _ -> raise (Eval_error "ends-with?: 2 string args"));
  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
        | String x, String y -> x = y | Number x, Number 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; Number start; Number end_] ->
      let i = int_of_float start and j = int_of_float end_ 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; Number start; Number len] ->
      let i = int_of_float start and n = int_of_float len 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; Number start] ->
      let i = int_of_float start 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"
      | 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
    | [Number n] ->
      let buf = Buffer.create 4 in
      Buffer.add_utf_8_uchar buf (Uchar.of_int (int_of_float n));
      String (Buffer.contents buf)
    | _ -> raise (Eval_error "char-from-code: 1 arg"));
  register "char-at" (fun args ->
    match args with
    | [String s; Number n] ->
      let i = int_of_float 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 -> Number (float_of_int (Char.code s.[0]))
    | _ -> raise (Eval_error "char-code: 1 non-empty string arg"));
  register "parse-number" (fun args ->
    match args with
    | [String s] ->
      (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 }] -> Number (float_of_int (List.length l))
    | [String s] -> Number (float_of_int (String.length s))
    | [Dict d] -> Number (float_of_int (Hashtbl.length d))
    | [Nil] | [Bool false] -> Number 0.0
    | [Bool true] -> Number 1.0
    | [Number _] -> Number 1.0
    | [RawHTML s] -> Number (float_of_int (String.length s))
    | [SxExpr s] -> Number (float_of_int (String.length s))
    | [Spread pairs] -> Number (float_of_int (List.length pairs))
    | [Component _] | [Island _] | [Lambda _] | [NativeFn _]
    | [Macro _] | [Thunk _] | [Keyword _] | [Symbol _] -> Number 0.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; Number n] | [ListRef { contents = l }; Number n] ->
      (try List.nth l (int_of_float n) with _ -> Nil)
    | [String s; Number n] ->
      let i = int_of_float 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
         | Number x, Number y -> x = 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
    | [Number stop] ->
      let n = int_of_float stop in
      List (List.init (max 0 n) (fun i -> Number (float_of_int i)))
    | [Number start; Number stop] ->
      let s = int_of_float start and e = int_of_float stop in
      let len = max 0 (e - s) in
      List (List.init len (fun i -> Number (float_of_int (s + i))))
    | [Number start; Number stop; Number step] ->
      let s = start and e = stop and st = step 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 }); Number start] ->
      let i = max 0 (int_of_float start) 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 }); Number start; Number end_] ->
      let i = max 0 (int_of_float start) and j = int_of_float end_ 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; Number start] ->
      let i = max 0 (int_of_float start) in
      String (String.sub s i (max 0 (String.length s - i)))
    | [String s; Number start; Number end_] ->
      let i = max 0 (int_of_float start) and j = int_of_float end_ 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 }); Number n] ->
      let rec take_n i = function
        | x :: xs when i > 0 -> x :: take_n (i-1) xs
        | _ -> []
      in List (take_n (int_of_float n) l)
    | _ -> raise (Eval_error "take: list and number"));
  register "drop" (fun args ->
    match args with
    | [(List l | ListRef { contents = l }); Number n] ->
      let rec drop_n i = function
        | _ :: xs when i > 0 -> drop_n (i-1) xs
        | l -> l
      in List (drop_n (int_of_float n) l)
    | _ -> raise (Eval_error "drop: list and number"));
  register "chunk-every" (fun args ->
    match args with
    | [(List l | ListRef { contents = l }); Number n] ->
      let size = int_of_float 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; Number n] | [ListRef { contents = l }; Number n] ->
      (try List.nth l (int_of_float 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; Number n; v] ->
      let i = int_of_float n 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 "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] -> Bool (a == b) | _ -> 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 [Number (float_of_int 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
    | [Number n] -> ListRef (ref (List.init (int_of_float n) (fun _ -> Nil)))
    | _ -> raise (Eval_error "make-vm-stack: expected (size)"));
  register "vm-stack-get" (fun args ->
    match args with
    | [ListRef r; Number n] -> List.nth !r (int_of_float n)
    | _ -> raise (Eval_error "vm-stack-get: expected (stack idx)"));
  register "vm-stack-set!" (fun args ->
    match args with
    | [ListRef r; Number n; v] ->
      let i = int_of_float 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] -> Number (float_of_int (List.length !r))
    | _ -> raise (Eval_error "vm-stack-length: expected (stack)"));
  register "vm-stack-copy!" (fun args ->
    match args with
    | [ListRef src; ListRef dst; Number n] ->
      let count = int_of_float 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
    | [Number n] -> Vector (Array.make (int_of_float n) Nil)
    | [Number n; fill] -> Vector (Array.make (int_of_float 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] -> Number (float_of_int (Array.length arr))
    | _ -> raise (Eval_error "vector-length: expected vector"));
  register "vector-ref" (fun args ->
    match args with
    | [Vector arr; Number n] -> arr.(int_of_float n)
    | _ -> raise (Eval_error "vector-ref: expected (vector index)"));
  register "vector-set!" (fun args ->
    match args with
    | [Vector arr; Number n; v] -> arr.(int_of_float n) <- 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)
    | _ -> raise (Eval_error "vector-copy: expected vector"));

  (* 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)