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