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

let 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)
  | v -> raise (Eval_error ("Expected number, got " ^ type_of v))

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

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

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

let 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
  | 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 ->
    match args with
    | [String s] -> (match int_of_string_opt s with Some n -> Number (float_of_int n) | None -> Nil)
    | [Number n] -> Number (float_of_int (int_of_float n))
    | _ -> 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 === *)
  (* Normalize ListRef to List for structural equality *)
  let rec normalize_for_eq = function
    | ListRef { contents = items } -> List (List.map normalize_for_eq items)
    | List items -> List (List.map normalize_for_eq items)
    | v -> v
  in
  register "=" (fun args ->
    match args with
    | [a; b] -> Bool (normalize_for_eq a = normalize_for_eq b)
    | _ -> raise (Eval_error "=: 2 args"));
  register "!=" (fun args ->
    match args with
    | [a; b] -> Bool (normalize_for_eq a <> normalize_for_eq 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 "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
    | _ -> raise (Eval_error "index-of: 2 string args"));
  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 ->
    match args with
    | [String s; String old_s; String new_s] ->
      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] -> Number 0.0
    | _ -> raise (Eval_error "len: 1 arg"));
  register "first" (fun args ->
    match args with
    | [List (x :: _)] | [ListRef { contents = x :: _ }] -> x
    | [List []] | [ListRef { contents = [] }] -> Nil | [Nil] -> Nil
    | _ -> 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 "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 ->
    let all = List.concat_map (fun a -> as_list a) args in
    List all);
  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] -> Bool (List.mem 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)
    | _ -> raise (Eval_error "get: dict+key or list+index"));
  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
    | [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 "apply" (fun args ->
    match args with
    | [NativeFn (_, f); List a] -> f a
    | _ -> 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 })] ->
      (try List.find (fun x -> sx_truthy (call_any f [x])) items
       with Not_found -> Bool false)
    | [_; 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)"));
  ()