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 "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)
    (* 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] ->
      List (List.map (fun p -> String p) (String.split_on_char sep.[0] 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"));

  (* === 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>"
    | [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);
  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);

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