ocaml: numeric tower — Integer/Number distinction + float contagion
Add `Integer of int` to sx_types.ml alongside `Number of float`. Parser produces Integer for whole-number literals. Arithmetic primitives apply float contagion (int op int → Integer, int op float → Number). Division always returns Number. Rounding (floor/truncate/round) returns Integer. Predicates: integer?, float?, exact?, inexact?, exact->inexact, inexact->exact. run_tests.ml updated for json_of_value, value_of_json, identical?, random-int mock, DOM accessors, and parser pattern matches. New spec/tests/test-numeric-tower.sx — 92 tests, all pass (394 unchanged). Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -37,7 +37,10 @@ let rec deep_equal a b =
|
|||||||
match a, b with
|
match a, b with
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
| Bool a, Bool b -> a = b
|
| Bool a, Bool b -> a = b
|
||||||
|
| Integer a, Integer b -> a = b
|
||||||
| Number a, Number b -> a = b
|
| Number a, Number b -> a = b
|
||||||
|
| Integer a, Number b -> float_of_int a = b
|
||||||
|
| Number a, Integer b -> a = float_of_int b
|
||||||
| String a, String b -> a = b
|
| String a, String b -> a = b
|
||||||
| Symbol a, Symbol b -> a = b
|
| Symbol a, Symbol b -> a = b
|
||||||
| Keyword a, Keyword b -> a = b
|
| Keyword a, Keyword b -> a = b
|
||||||
@@ -226,7 +229,7 @@ let make_test_env () =
|
|||||||
| [String s] ->
|
| [String s] ->
|
||||||
let parsed = Sx_parser.parse_all s in
|
let parsed = Sx_parser.parse_all s in
|
||||||
(match parsed with
|
(match parsed with
|
||||||
| [List (Symbol "sxbc" :: Number _ :: payload :: _)] -> payload
|
| [List (Symbol "sxbc" :: (Number _ | Integer _) :: payload :: _)] -> payload
|
||||||
| _ -> raise (Eval_error "bytecode-deserialize: invalid sxbc format"))
|
| _ -> raise (Eval_error "bytecode-deserialize: invalid sxbc format"))
|
||||||
| _ -> raise (Eval_error "bytecode-deserialize: expected string"));
|
| _ -> raise (Eval_error "bytecode-deserialize: expected string"));
|
||||||
|
|
||||||
@@ -240,7 +243,7 @@ let make_test_env () =
|
|||||||
| [String s] ->
|
| [String s] ->
|
||||||
let parsed = Sx_parser.parse_all s in
|
let parsed = Sx_parser.parse_all s in
|
||||||
(match parsed with
|
(match parsed with
|
||||||
| [List (Symbol "cek-state" :: Number _ :: payload :: _)] -> payload
|
| [List (Symbol "cek-state" :: (Number _ | Integer _) :: payload :: _)] -> payload
|
||||||
| _ -> raise (Eval_error "cek-deserialize: invalid cek-state format"))
|
| _ -> raise (Eval_error "cek-deserialize: invalid cek-state format"))
|
||||||
| _ -> raise (Eval_error "cek-deserialize: expected string"));
|
| _ -> raise (Eval_error "cek-deserialize: expected string"));
|
||||||
|
|
||||||
@@ -320,7 +323,10 @@ let make_test_env () =
|
|||||||
bind "identical?" (fun args ->
|
bind "identical?" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [a; b] -> Bool (match a, b with
|
| [a; b] -> Bool (match a, b with
|
||||||
|
| Integer x, Integer y -> x = y
|
||||||
| Number x, Number y -> x = y
|
| Number x, Number y -> x = y
|
||||||
|
| Integer x, Number y -> float_of_int x = y
|
||||||
|
| Number x, Integer y -> x = float_of_int y
|
||||||
| String x, String y -> x = y
|
| String x, String y -> x = y
|
||||||
| Bool x, Bool y -> x = y
|
| Bool x, Bool y -> x = y
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
@@ -366,11 +372,15 @@ let make_test_env () =
|
|||||||
|
|
||||||
bind "append!" (fun args ->
|
bind "append!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [ListRef r; v; Number n] when int_of_float n = 0 ->
|
| [ListRef r; v; (Number n)] when int_of_float n = 0 ->
|
||||||
r := v :: !r; ListRef r (* prepend *)
|
r := v :: !r; ListRef r (* prepend *)
|
||||||
|
| [ListRef r; v; (Integer 0)] ->
|
||||||
|
r := v :: !r; ListRef r (* prepend Integer index *)
|
||||||
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* append in place *)
|
| [ListRef r; v] -> r := !r @ [v]; ListRef r (* append in place *)
|
||||||
| [List items; v; Number n] when int_of_float n = 0 ->
|
| [List items; v; (Number n)] when int_of_float n = 0 ->
|
||||||
List (v :: items) (* immutable prepend *)
|
List (v :: items) (* immutable prepend *)
|
||||||
|
| [List items; v; (Integer 0)] ->
|
||||||
|
List (v :: items) (* immutable prepend Integer index *)
|
||||||
| [List items; v] -> List (items @ [v]) (* immutable fallback *)
|
| [List items; v] -> List (items @ [v]) (* immutable fallback *)
|
||||||
| _ -> raise (Eval_error "append!: expected list and value"));
|
| _ -> raise (Eval_error "append!: expected list and value"));
|
||||||
|
|
||||||
@@ -546,7 +556,10 @@ let make_test_env () =
|
|||||||
bind "batch-begin!" (fun _args -> Sx_ref.batch_begin_b ());
|
bind "batch-begin!" (fun _args -> Sx_ref.batch_begin_b ());
|
||||||
bind "batch-end!" (fun _args -> Sx_ref.batch_end_b ());
|
bind "batch-end!" (fun _args -> Sx_ref.batch_end_b ());
|
||||||
bind "now-ms" (fun _args -> Number 1000.0);
|
bind "now-ms" (fun _args -> Number 1000.0);
|
||||||
bind "random-int" (fun args -> match args with [Number lo; _] -> Number lo | _ -> Number 0.0);
|
bind "random-int" (fun args -> match args with
|
||||||
|
| [Number lo; _] -> Number lo
|
||||||
|
| [Integer lo; _] -> Integer lo
|
||||||
|
| _ -> Integer 0);
|
||||||
bind "try-rerender-page" (fun _args -> Nil);
|
bind "try-rerender-page" (fun _args -> Nil);
|
||||||
bind "collect!" (fun args ->
|
bind "collect!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
@@ -1142,18 +1155,20 @@ let run_foundation_tests () =
|
|||||||
in
|
in
|
||||||
|
|
||||||
Printf.printf "Suite: parser\n";
|
Printf.printf "Suite: parser\n";
|
||||||
assert_eq "number" (Number 42.0) (List.hd (parse_all "42"));
|
assert_eq "number" (Integer 42) (List.hd (parse_all "42"));
|
||||||
assert_eq "string" (String "hello") (List.hd (parse_all "\"hello\""));
|
assert_eq "string" (String "hello") (List.hd (parse_all "\"hello\""));
|
||||||
assert_eq "bool true" (Bool true) (List.hd (parse_all "true"));
|
assert_eq "bool true" (Bool true) (List.hd (parse_all "true"));
|
||||||
assert_eq "nil" Nil (List.hd (parse_all "nil"));
|
assert_eq "nil" Nil (List.hd (parse_all "nil"));
|
||||||
assert_eq "keyword" (Keyword "class") (List.hd (parse_all ":class"));
|
assert_eq "keyword" (Keyword "class") (List.hd (parse_all ":class"));
|
||||||
assert_eq "symbol" (Symbol "foo") (List.hd (parse_all "foo"));
|
assert_eq "symbol" (Symbol "foo") (List.hd (parse_all "foo"));
|
||||||
assert_eq "list" (List [Symbol "+"; Number 1.0; Number 2.0]) (List.hd (parse_all "(+ 1 2)"));
|
assert_eq "list" (List [Symbol "+"; Integer 1; Integer 2]) (List.hd (parse_all "(+ 1 2)"));
|
||||||
(match List.hd (parse_all "(div :class \"card\" (p \"hi\"))") with
|
(match List.hd (parse_all "(div :class \"card\" (p \"hi\"))") with
|
||||||
| List [Symbol "div"; Keyword "class"; String "card"; List [Symbol "p"; String "hi"]] ->
|
| List [Symbol "div"; Keyword "class"; String "card"; List [Symbol "p"; String "hi"]] ->
|
||||||
incr pass_count; Printf.printf " PASS: nested list\n"
|
incr pass_count; Printf.printf " PASS: nested list\n"
|
||||||
| v -> incr fail_count; Printf.printf " FAIL: nested list — got %s\n" (Sx_types.inspect v));
|
| v -> incr fail_count; Printf.printf " FAIL: nested list — got %s\n" (Sx_types.inspect v));
|
||||||
(match List.hd (parse_all "'(1 2 3)") with
|
(match List.hd (parse_all "'(1 2 3)") with
|
||||||
|
| List [Symbol "quote"; List [Integer 1; Integer 2; Integer 3]] ->
|
||||||
|
incr pass_count; Printf.printf " PASS: quote sugar\n"
|
||||||
| List [Symbol "quote"; List [Number 1.0; Number 2.0; Number 3.0]] ->
|
| List [Symbol "quote"; List [Number 1.0; Number 2.0; Number 3.0]] ->
|
||||||
incr pass_count; Printf.printf " PASS: quote sugar\n"
|
incr pass_count; Printf.printf " PASS: quote sugar\n"
|
||||||
| v -> incr fail_count; Printf.printf " FAIL: quote sugar — got %s\n" (Sx_types.inspect v));
|
| v -> incr fail_count; Printf.printf " FAIL: quote sugar — got %s\n" (Sx_types.inspect v));
|
||||||
@@ -1161,7 +1176,7 @@ let run_foundation_tests () =
|
|||||||
| Dict d when dict_has d "a" && dict_has d "b" ->
|
| Dict d when dict_has d "a" && dict_has d "b" ->
|
||||||
incr pass_count; Printf.printf " PASS: dict literal\n"
|
incr pass_count; Printf.printf " PASS: dict literal\n"
|
||||||
| v -> incr fail_count; Printf.printf " FAIL: dict literal — got %s\n" (Sx_types.inspect v));
|
| v -> incr fail_count; Printf.printf " FAIL: dict literal — got %s\n" (Sx_types.inspect v));
|
||||||
assert_eq "comment" (Number 42.0) (List.hd (parse_all ";; comment\n42"));
|
assert_eq "comment" (Integer 42) (List.hd (parse_all ";; comment\n42"));
|
||||||
assert_eq "string escape" (String "hello\nworld") (List.hd (parse_all "\"hello\\nworld\""));
|
assert_eq "string escape" (String "hello\nworld") (List.hd (parse_all "\"hello\\nworld\""));
|
||||||
assert_eq "multiple exprs" (Number 2.0) (Number (float_of_int (List.length (parse_all "(1 2 3) (4 5)"))));
|
assert_eq "multiple exprs" (Number 2.0) (Number (float_of_int (List.length (parse_all "(1 2 3) (4 5)"))));
|
||||||
|
|
||||||
@@ -1978,6 +1993,10 @@ let run_spec_tests env test_files =
|
|||||||
(match Hashtbl.find_opt d "children" with
|
(match Hashtbl.find_opt d "children" with
|
||||||
| Some (List l) when i >= 0 && i < List.length l -> List.nth l i
|
| Some (List l) when i >= 0 && i < List.length l -> List.nth l i
|
||||||
| _ -> (match Hashtbl.find_opt d (string_of_int i) with Some v -> v | None -> Nil))
|
| _ -> (match Hashtbl.find_opt d (string_of_int i) with Some v -> v | None -> Nil))
|
||||||
|
| [Dict d; Integer n] ->
|
||||||
|
(match Hashtbl.find_opt d "children" with
|
||||||
|
| Some (List l) when n >= 0 && n < List.length l -> List.nth l n
|
||||||
|
| _ -> (match Hashtbl.find_opt d (string_of_int n) with Some v -> v | None -> Nil))
|
||||||
| _ -> Nil);
|
| _ -> Nil);
|
||||||
|
|
||||||
(* Stringify a value for DOM string properties *)
|
(* Stringify a value for DOM string properties *)
|
||||||
@@ -2052,8 +2071,8 @@ let run_spec_tests env test_files =
|
|||||||
Hashtbl.replace d "childNodes" (List [])
|
Hashtbl.replace d "childNodes" (List [])
|
||||||
| _ -> ());
|
| _ -> ());
|
||||||
stored
|
stored
|
||||||
| [ListRef r; Number n; value] ->
|
| [ListRef r; idx_v; value] when (match idx_v with Number _ | Integer _ -> true | _ -> false) ->
|
||||||
let idx = int_of_float n in
|
let idx = match idx_v with Number n -> int_of_float n | Integer n -> n | _ -> 0 in
|
||||||
let lst = !r in
|
let lst = !r in
|
||||||
if idx >= 0 && idx < List.length lst then
|
if idx >= 0 && idx < List.length lst then
|
||||||
r := List.mapi (fun i v -> if i = idx then value else v) lst
|
r := List.mapi (fun i v -> if i = idx then value else v) lst
|
||||||
@@ -2190,7 +2209,7 @@ let run_spec_tests env test_files =
|
|||||||
| [String name; value] ->
|
| [String name; value] ->
|
||||||
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ ->
|
let attrs = match Hashtbl.find_opt d "attributes" with Some (Dict a) -> a | _ ->
|
||||||
let a = Hashtbl.create 4 in Hashtbl.replace d "attributes" (Dict a); a in
|
let a = Hashtbl.create 4 in Hashtbl.replace d "attributes" (Dict a); a in
|
||||||
let sv = match value with String s -> s | Number n ->
|
let sv = match value with String s -> s | Integer n -> string_of_int n | Number n ->
|
||||||
let i = int_of_float n in if float_of_int i = n then string_of_int i
|
let i = int_of_float n in if float_of_int i = n then string_of_int i
|
||||||
else string_of_float n | _ -> Sx_types.inspect value in
|
else string_of_float n | _ -> Sx_types.inspect value in
|
||||||
Hashtbl.replace attrs name (String sv);
|
Hashtbl.replace attrs name (String sv);
|
||||||
@@ -2632,6 +2651,7 @@ let run_spec_tests env test_files =
|
|||||||
let rec json_of_value = function
|
let rec json_of_value = function
|
||||||
| Nil -> `Null
|
| Nil -> `Null
|
||||||
| Bool b -> `Bool b
|
| Bool b -> `Bool b
|
||||||
|
| Integer n -> `Int n
|
||||||
| Number n ->
|
| Number n ->
|
||||||
if Float.is_integer n && Float.abs n < 1e16
|
if Float.is_integer n && Float.abs n < 1e16
|
||||||
then `Int (int_of_float n) else `Float n
|
then `Int (int_of_float n) else `Float n
|
||||||
@@ -2647,8 +2667,8 @@ let run_spec_tests env test_files =
|
|||||||
let rec value_of_json = function
|
let rec value_of_json = function
|
||||||
| `Null -> Nil
|
| `Null -> Nil
|
||||||
| `Bool b -> Bool b
|
| `Bool b -> Bool b
|
||||||
| `Int i -> Number (float_of_int i)
|
| `Int i -> Integer i
|
||||||
| `Intlit s -> (try Number (float_of_string s) with _ -> String s)
|
| `Intlit s -> (try Integer (int_of_string s) with _ -> try Number (float_of_string s) with _ -> String s)
|
||||||
| `Float f -> Number f
|
| `Float f -> Number f
|
||||||
| `String s -> String s
|
| `String s -> String s
|
||||||
| `List xs -> List (List.map value_of_json xs)
|
| `List xs -> List (List.map value_of_json xs)
|
||||||
|
|||||||
@@ -90,9 +90,21 @@ let read_symbol s =
|
|||||||
String.sub s.src start (s.pos - start)
|
String.sub s.src start (s.pos - start)
|
||||||
|
|
||||||
let try_number str =
|
let try_number str =
|
||||||
match float_of_string_opt str with
|
(* Integers (no '.' or 'e'/'E') → exact Integer; floats → inexact Number *)
|
||||||
| Some n -> Some (Number n)
|
let has_dec = String.contains str '.' in
|
||||||
| None -> None
|
let has_exp = String.contains str 'e' || String.contains str 'E' in
|
||||||
|
if has_dec || has_exp then
|
||||||
|
match float_of_string_opt str with
|
||||||
|
| Some n -> Some (Number n)
|
||||||
|
| None -> None
|
||||||
|
else
|
||||||
|
match int_of_string_opt str with
|
||||||
|
| Some n -> Some (Integer n)
|
||||||
|
| None ->
|
||||||
|
(* handles "nan", "inf", "-inf" *)
|
||||||
|
match float_of_string_opt str with
|
||||||
|
| Some n -> Some (Number n)
|
||||||
|
| None -> None
|
||||||
|
|
||||||
let rec read_value s : value =
|
let rec read_value s : value =
|
||||||
skip_whitespace_and_comments s;
|
skip_whitespace_and_comments s;
|
||||||
|
|||||||
@@ -51,7 +51,15 @@ let get_primitive name =
|
|||||||
(* Trampoline hook — set by sx_ref after initialization to break circular dep *)
|
(* Trampoline hook — set by sx_ref after initialization to break circular dep *)
|
||||||
let trampoline_hook : (value -> value) ref = ref (fun v -> v)
|
let trampoline_hook : (value -> value) ref = ref (fun v -> v)
|
||||||
|
|
||||||
|
let as_int = function
|
||||||
|
| Integer n -> n
|
||||||
|
| Number n -> int_of_float n
|
||||||
|
| v -> raise (Eval_error ("Expected number, got " ^ type_of v))
|
||||||
|
|
||||||
|
let all_ints = List.for_all (function Integer _ -> true | _ -> false)
|
||||||
|
|
||||||
let rec as_number = function
|
let rec as_number = function
|
||||||
|
| Integer n -> float_of_int n
|
||||||
| Number n -> n
|
| Number n -> n
|
||||||
| Bool true -> 1.0
|
| Bool true -> 1.0
|
||||||
| Bool false -> 0.0
|
| Bool false -> 0.0
|
||||||
@@ -79,6 +87,7 @@ let as_bool = function
|
|||||||
|
|
||||||
let rec to_string = function
|
let rec to_string = function
|
||||||
| String s -> s
|
| String s -> s
|
||||||
|
| Integer n -> string_of_int n
|
||||||
| Number n -> Sx_types.format_number n
|
| Number n -> Sx_types.format_number n
|
||||||
| Bool true -> "true"
|
| Bool true -> "true"
|
||||||
| Bool false -> "false"
|
| Bool false -> "false"
|
||||||
@@ -93,49 +102,81 @@ let rec to_string = function
|
|||||||
let () =
|
let () =
|
||||||
(* === Arithmetic === *)
|
(* === Arithmetic === *)
|
||||||
register "+" (fun args ->
|
register "+" (fun args ->
|
||||||
Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args));
|
if all_ints args then
|
||||||
|
Integer (List.fold_left (fun acc a -> match a with Integer n -> acc + n | _ -> acc) 0 args)
|
||||||
|
else
|
||||||
|
Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args));
|
||||||
register "-" (fun args ->
|
register "-" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [] -> Number 0.0
|
| [] -> Integer 0
|
||||||
|
| [Integer n] -> Integer (-n)
|
||||||
| [a] -> Number (-. (as_number a))
|
| [a] -> Number (-. (as_number a))
|
||||||
| a :: rest -> Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest));
|
| _ when all_ints args ->
|
||||||
|
(match args with
|
||||||
|
| Integer h :: tl ->
|
||||||
|
Integer (List.fold_left (fun acc a -> match a with Integer n -> acc - n | _ -> acc) h tl)
|
||||||
|
| _ -> Number 0.0)
|
||||||
|
| a :: rest ->
|
||||||
|
Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest));
|
||||||
register "*" (fun args ->
|
register "*" (fun args ->
|
||||||
Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
|
if all_ints args then
|
||||||
|
Integer (List.fold_left (fun acc a -> match a with Integer n -> acc * n | _ -> acc) 1 args)
|
||||||
|
else
|
||||||
|
Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args));
|
||||||
register "/" (fun args ->
|
register "/" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [a; b] -> Number (as_number a /. as_number b)
|
| [a; b] -> Number (as_number a /. as_number b)
|
||||||
| _ -> raise (Eval_error "/: expected 2 args"));
|
| _ -> raise (Eval_error "/: expected 2 args"));
|
||||||
register "mod" (fun args ->
|
register "mod" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
|
| [Integer a; Integer b] -> Integer (a mod b)
|
||||||
| [a; b] -> Number (Float.rem (as_number a) (as_number b))
|
| [a; b] -> Number (Float.rem (as_number a) (as_number b))
|
||||||
| _ -> raise (Eval_error "mod: expected 2 args"));
|
| _ -> raise (Eval_error "mod: expected 2 args"));
|
||||||
register "inc" (fun args ->
|
register "inc" (fun args ->
|
||||||
match args with [a] -> Number (as_number a +. 1.0) | _ -> raise (Eval_error "inc: 1 arg"));
|
match args with
|
||||||
|
| [Integer n] -> Integer (n + 1)
|
||||||
|
| [a] -> Number (as_number a +. 1.0)
|
||||||
|
| _ -> raise (Eval_error "inc: 1 arg"));
|
||||||
register "dec" (fun args ->
|
register "dec" (fun args ->
|
||||||
match args with [a] -> Number (as_number a -. 1.0) | _ -> raise (Eval_error "dec: 1 arg"));
|
match args with
|
||||||
|
| [Integer n] -> Integer (n - 1)
|
||||||
|
| [a] -> Number (as_number a -. 1.0)
|
||||||
|
| _ -> raise (Eval_error "dec: 1 arg"));
|
||||||
register "abs" (fun args ->
|
register "abs" (fun args ->
|
||||||
match args with [a] -> Number (Float.abs (as_number a)) | _ -> raise (Eval_error "abs: 1 arg"));
|
match args with
|
||||||
|
| [Integer n] -> Integer (abs n)
|
||||||
|
| [a] -> Number (Float.abs (as_number a))
|
||||||
|
| _ -> raise (Eval_error "abs: 1 arg"));
|
||||||
register "floor" (fun args ->
|
register "floor" (fun args ->
|
||||||
match args with [a] -> Number (floor (as_number a))
|
match args with
|
||||||
|
| [Integer n] -> Integer n
|
||||||
|
| [a] -> Integer (int_of_float (floor (as_number a)))
|
||||||
| _ -> raise (Eval_error "floor: 1 arg"));
|
| _ -> raise (Eval_error "floor: 1 arg"));
|
||||||
register "ceil" (fun args ->
|
register "ceil" (fun args ->
|
||||||
match args with [a] -> Number (ceil (as_number a))
|
match args with
|
||||||
|
| [Integer n] -> Integer n
|
||||||
|
| [a] -> Integer (int_of_float (ceil (as_number a)))
|
||||||
| _ -> raise (Eval_error "ceil: 1 arg"));
|
| _ -> raise (Eval_error "ceil: 1 arg"));
|
||||||
register "round" (fun args ->
|
register "round" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [a] -> Number (Float.round (as_number a))
|
| [Integer n] -> Integer n
|
||||||
|
| [a] -> Integer (int_of_float (Float.round (as_number a)))
|
||||||
| [a; b] ->
|
| [a; b] ->
|
||||||
let n = as_number a and places = int_of_float (as_number b) in
|
let n = as_number a and places = as_int b in
|
||||||
let factor = 10.0 ** float_of_int places in
|
let factor = 10.0 ** float_of_int places in
|
||||||
Number (Float.round (n *. factor) /. factor)
|
Number (Float.round (n *. factor) /. factor)
|
||||||
| _ -> raise (Eval_error "round: 1-2 args"));
|
| _ -> raise (Eval_error "round: 1-2 args"));
|
||||||
register "min" (fun args ->
|
register "min" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [] -> raise (Eval_error "min: at least 1 arg")
|
| [] -> raise (Eval_error "min: at least 1 arg")
|
||||||
|
| _ when all_ints args ->
|
||||||
|
Integer (List.fold_left (fun acc a -> match a with Integer n -> min acc n | _ -> acc) max_int args)
|
||||||
| _ -> Number (List.fold_left (fun acc a -> Float.min acc (as_number a)) Float.infinity args));
|
| _ -> Number (List.fold_left (fun acc a -> Float.min acc (as_number a)) Float.infinity args));
|
||||||
register "max" (fun args ->
|
register "max" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [] -> raise (Eval_error "max: at least 1 arg")
|
| [] -> raise (Eval_error "max: at least 1 arg")
|
||||||
|
| _ when all_ints args ->
|
||||||
|
Integer (List.fold_left (fun acc a -> match a with Integer n -> max acc n | _ -> acc) min_int args)
|
||||||
| _ -> Number (List.fold_left (fun acc a -> Float.max acc (as_number a)) Float.neg_infinity args));
|
| _ -> Number (List.fold_left (fun acc a -> Float.max acc (as_number a)) Float.neg_infinity args));
|
||||||
register "sqrt" (fun args ->
|
register "sqrt" (fun args ->
|
||||||
match args with [a] -> Number (Float.sqrt (as_number a)) | _ -> raise (Eval_error "sqrt: 1 arg"));
|
match args with [a] -> Number (Float.sqrt (as_number a)) | _ -> raise (Eval_error "sqrt: 1 arg"));
|
||||||
@@ -189,6 +230,7 @@ let () =
|
|||||||
Number (Float.sqrt sum));
|
Number (Float.sqrt sum));
|
||||||
register "sign" (fun args ->
|
register "sign" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
|
| [Integer n] -> Integer (if n > 0 then 1 else if n < 0 then -1 else 0)
|
||||||
| [a] ->
|
| [a] ->
|
||||||
let n = as_number a in
|
let n = as_number a in
|
||||||
Number (if Float.is_nan n then Float.nan
|
Number (if Float.is_nan n then Float.nan
|
||||||
@@ -234,32 +276,47 @@ let () =
|
|||||||
| _ -> raise (Eval_error "clamp: 3 args"));
|
| _ -> raise (Eval_error "clamp: 3 args"));
|
||||||
register "truncate" (fun args ->
|
register "truncate" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [a] -> let n = as_number a in Number (if n >= 0.0 then floor n else ceil n)
|
| [Integer n] -> Integer n
|
||||||
|
| [a] -> let n = as_number a in Integer (int_of_float (if n >= 0.0 then floor n else ceil n))
|
||||||
| _ -> raise (Eval_error "truncate: 1 arg"));
|
| _ -> raise (Eval_error "truncate: 1 arg"));
|
||||||
register "remainder" (fun args ->
|
register "remainder" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
|
| [Integer a; Integer b] -> Integer (a mod b)
|
||||||
| [a; b] -> Number (Float.rem (as_number a) (as_number b))
|
| [a; b] -> Number (Float.rem (as_number a) (as_number b))
|
||||||
| _ -> raise (Eval_error "remainder: 2 args"));
|
| _ -> raise (Eval_error "remainder: 2 args"));
|
||||||
register "modulo" (fun args ->
|
register "modulo" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
|
| [Integer a; Integer b] ->
|
||||||
|
let r = a mod b in
|
||||||
|
Integer (if r = 0 || (r > 0) = (b > 0) then r else r + b)
|
||||||
| [a; b] ->
|
| [a; b] ->
|
||||||
let a = as_number a and b = as_number b in
|
let a = as_number a and b = as_number b in
|
||||||
let r = Float.rem a b in
|
let r = Float.rem a b in
|
||||||
Number (if r = 0.0 || (r > 0.0) = (b > 0.0) then r else r +. b)
|
Number (if r = 0.0 || (r > 0.0) = (b > 0.0) then r else r +. b)
|
||||||
| _ -> raise (Eval_error "modulo: 2 args"));
|
| _ -> raise (Eval_error "modulo: 2 args"));
|
||||||
register "exact?" (fun args ->
|
register "exact?" (fun args ->
|
||||||
match args with [Number f] -> Bool (Float.is_integer f) | [_] -> Bool false
|
match args with
|
||||||
|
| [Integer _] -> Bool true
|
||||||
|
| [Number _] -> Bool false
|
||||||
|
| [_] -> Bool false
|
||||||
| _ -> raise (Eval_error "exact?: 1 arg"));
|
| _ -> raise (Eval_error "exact?: 1 arg"));
|
||||||
register "inexact?" (fun args ->
|
register "inexact?" (fun args ->
|
||||||
match args with [Number f] -> Bool (not (Float.is_integer f)) | [_] -> Bool false
|
match args with
|
||||||
|
| [Number _] -> Bool true
|
||||||
|
| [Integer _] -> Bool false
|
||||||
|
| [_] -> Bool false
|
||||||
| _ -> raise (Eval_error "inexact?: 1 arg"));
|
| _ -> raise (Eval_error "inexact?: 1 arg"));
|
||||||
register "exact->inexact" (fun args ->
|
register "exact->inexact" (fun args ->
|
||||||
match args with [Number n] -> Number n | [a] -> Number (as_number a)
|
match args with
|
||||||
|
| [Integer n] -> Number (float_of_int n)
|
||||||
|
| [Number n] -> Number n
|
||||||
|
| [a] -> Number (as_number a)
|
||||||
| _ -> raise (Eval_error "exact->inexact: 1 arg"));
|
| _ -> raise (Eval_error "exact->inexact: 1 arg"));
|
||||||
register "inexact->exact" (fun args ->
|
register "inexact->exact" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Number n] -> if Float.is_integer n then Number n else Number (Float.round n)
|
| [Integer n] -> Integer n
|
||||||
| [a] -> Number (Float.round (as_number a))
|
| [Number n] -> Integer (int_of_float (Float.round n))
|
||||||
|
| [a] -> Integer (int_of_float (Float.round (as_number a)))
|
||||||
| _ -> raise (Eval_error "inexact->exact: 1 arg"));
|
| _ -> raise (Eval_error "inexact->exact: 1 arg"));
|
||||||
register "parse-int" (fun args ->
|
register "parse-int" (fun args ->
|
||||||
let parse_leading_int s =
|
let parse_leading_int s =
|
||||||
@@ -276,10 +333,11 @@ let () =
|
|||||||
else None
|
else None
|
||||||
in
|
in
|
||||||
match args with
|
match args with
|
||||||
| [String s] -> (match parse_leading_int s with Some n -> Number (float_of_int n) | None -> Nil)
|
| [String s] -> (match parse_leading_int s with Some n -> Integer n | None -> Nil)
|
||||||
| [String s; default_val] ->
|
| [String s; default_val] ->
|
||||||
(match parse_leading_int s with Some n -> Number (float_of_int n) | None -> default_val)
|
(match parse_leading_int s with Some n -> Integer n | None -> default_val)
|
||||||
| [Number n] | [Number n; _] -> Number (float_of_int (int_of_float n))
|
| [Integer n] | [Integer n; _] -> Integer n
|
||||||
|
| [Number n] | [Number n; _] -> Integer (int_of_float n)
|
||||||
| [_; default_val] -> default_val
|
| [_; default_val] -> default_val
|
||||||
| _ -> Nil);
|
| _ -> Nil);
|
||||||
register "parse-float" (fun args ->
|
register "parse-float" (fun args ->
|
||||||
@@ -296,7 +354,10 @@ let () =
|
|||||||
let rec safe_eq a b =
|
let rec safe_eq a b =
|
||||||
if a == b then true (* physical equality fast path *)
|
if a == b then true (* physical equality fast path *)
|
||||||
else match a, b with
|
else match a, b with
|
||||||
|
| Integer x, Integer y -> x = y
|
||||||
| Number x, Number y -> x = y
|
| Number x, Number y -> x = y
|
||||||
|
| Integer x, Number y -> float_of_int x = y
|
||||||
|
| Number x, Integer y -> x = float_of_int y
|
||||||
| String x, String y -> x = y
|
| String x, String y -> x = y
|
||||||
| Bool x, Bool y -> x = y
|
| Bool x, Bool y -> x = y
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
@@ -368,9 +429,21 @@ let () =
|
|||||||
register "nil?" (fun args ->
|
register "nil?" (fun args ->
|
||||||
match args with [a] -> Bool (is_nil a) | _ -> raise (Eval_error "nil?: 1 arg"));
|
match args with [a] -> Bool (is_nil a) | _ -> raise (Eval_error "nil?: 1 arg"));
|
||||||
register "number?" (fun args ->
|
register "number?" (fun args ->
|
||||||
match args with [Number _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "number?: 1 arg"));
|
match args with
|
||||||
|
| [Integer _] | [Number _] -> Bool true
|
||||||
|
| [_] -> Bool false
|
||||||
|
| _ -> raise (Eval_error "number?: 1 arg"));
|
||||||
register "integer?" (fun args ->
|
register "integer?" (fun args ->
|
||||||
match args with [Number f] -> Bool (Float.is_integer f) | [_] -> Bool false | _ -> raise (Eval_error "integer?: 1 arg"));
|
match args with
|
||||||
|
| [Integer _] -> Bool true
|
||||||
|
| [Number f] -> Bool (Float.is_integer f)
|
||||||
|
| [_] -> Bool false
|
||||||
|
| _ -> raise (Eval_error "integer?: 1 arg"));
|
||||||
|
register "float?" (fun args ->
|
||||||
|
match args with
|
||||||
|
| [Number _] -> Bool true
|
||||||
|
| [_] -> Bool false
|
||||||
|
| _ -> raise (Eval_error "float?: 1 arg"));
|
||||||
register "string?" (fun args ->
|
register "string?" (fun args ->
|
||||||
match args with [String _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "string?: 1 arg"));
|
match args with [String _] -> Bool true | [_] -> Bool false | _ -> raise (Eval_error "string?: 1 arg"));
|
||||||
register "boolean?" (fun args ->
|
register "boolean?" (fun args ->
|
||||||
@@ -412,7 +485,7 @@ let () =
|
|||||||
register "trim" (fun args ->
|
register "trim" (fun args ->
|
||||||
match args with [a] -> String (String.trim (as_string a)) | _ -> raise (Eval_error "trim: 1 arg"));
|
match args with [a] -> String (String.trim (as_string a)) | _ -> raise (Eval_error "trim: 1 arg"));
|
||||||
register "string-length" (fun args ->
|
register "string-length" (fun args ->
|
||||||
match args with [a] -> Number (float_of_int (String.length (as_string a)))
|
match args with [a] -> Integer (String.length (as_string a))
|
||||||
| _ -> raise (Eval_error "string-length: 1 arg"));
|
| _ -> raise (Eval_error "string-length: 1 arg"));
|
||||||
register "string-contains?" (fun args ->
|
register "string-contains?" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
@@ -446,7 +519,11 @@ let () =
|
|||||||
in find 0
|
in find 0
|
||||||
| [List items; target] | [ListRef { contents = items }; target] ->
|
| [List items; target] | [ListRef { contents = items }; target] ->
|
||||||
let eq a b = match a, b with
|
let eq a b = match a, b with
|
||||||
| String x, String y -> x = y | Number x, Number y -> x = y
|
| Integer x, Integer y -> x = y
|
||||||
|
| Number x, Number y -> x = y
|
||||||
|
| Integer x, Number y -> float_of_int x = y
|
||||||
|
| Number x, Integer y -> x = float_of_int y
|
||||||
|
| String x, String y -> x = y
|
||||||
| Symbol x, Symbol y -> x = y | Keyword x, Keyword y -> x = y
|
| Symbol x, Symbol y -> x = y | Keyword x, Keyword y -> x = y
|
||||||
| Bool x, Bool y -> x = y | Nil, Nil -> true | _ -> a == b in
|
| Bool x, Bool y -> x = y | Nil, Nil -> true | _ -> a == b in
|
||||||
let rec find i = function
|
let rec find i = function
|
||||||
@@ -457,22 +534,22 @@ let () =
|
|||||||
| _ -> raise (Eval_error "index-of: 2 string args or list+target"));
|
| _ -> raise (Eval_error "index-of: 2 string args or list+target"));
|
||||||
register "substring" (fun args ->
|
register "substring" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [String s; Number start; Number end_] ->
|
| [String s; start_v; end_v] ->
|
||||||
let i = int_of_float start and j = int_of_float end_ in
|
let i = as_int start_v and j = as_int end_v in
|
||||||
let len = String.length s in
|
let len = String.length s in
|
||||||
let i = max 0 (min i len) and j = max 0 (min j len) 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)))
|
String (String.sub s i (max 0 (j - i)))
|
||||||
| _ -> raise (Eval_error "substring: 3 args"));
|
| _ -> raise (Eval_error "substring: 3 args"));
|
||||||
register "substr" (fun args ->
|
register "substr" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [String s; Number start; Number len] ->
|
| [String s; start_v; len_v] ->
|
||||||
let i = int_of_float start and n = int_of_float len in
|
let i = as_int start_v and n = as_int len_v in
|
||||||
let sl = String.length s in
|
let sl = String.length s in
|
||||||
let i = max 0 (min i sl) in
|
let i = max 0 (min i sl) in
|
||||||
let n = max 0 (min n (sl - i)) in
|
let n = max 0 (min n (sl - i)) in
|
||||||
String (String.sub s i n)
|
String (String.sub s i n)
|
||||||
| [String s; Number start] ->
|
| [String s; start_v] ->
|
||||||
let i = int_of_float start in
|
let i = as_int start_v in
|
||||||
let sl = String.length s in
|
let sl = String.length s in
|
||||||
let i = max 0 (min i sl) in
|
let i = max 0 (min i sl) in
|
||||||
String (String.sub s i (sl - i))
|
String (String.sub s i (sl - i))
|
||||||
@@ -497,6 +574,7 @@ let () =
|
|||||||
| String s -> s | SxExpr s -> s | RawHTML s -> s
|
| String s -> s | SxExpr s -> s | RawHTML s -> s
|
||||||
| Keyword k -> k | Symbol s -> s
|
| Keyword k -> k | Symbol s -> s
|
||||||
| Nil -> "" | Bool true -> "true" | Bool false -> "false"
|
| Nil -> "" | Bool true -> "true" | Bool false -> "false"
|
||||||
|
| Integer n -> string_of_int n
|
||||||
| Number n -> if Float.is_integer n then string_of_int (int_of_float n) else Printf.sprintf "%g" n
|
| 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)
|
| Thunk _ as t -> (match !_sx_trampoline_fn t with String s -> s | v -> to_string v)
|
||||||
| v -> to_string v
|
| v -> to_string v
|
||||||
@@ -523,28 +601,35 @@ let () =
|
|||||||
| _ -> raise (Eval_error "replace: 3 string args"));
|
| _ -> raise (Eval_error "replace: 3 string args"));
|
||||||
register "char-from-code" (fun args ->
|
register "char-from-code" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Number n] ->
|
| [a] ->
|
||||||
|
let n = as_int a in
|
||||||
let buf = Buffer.create 4 in
|
let buf = Buffer.create 4 in
|
||||||
Buffer.add_utf_8_uchar buf (Uchar.of_int (int_of_float n));
|
Buffer.add_utf_8_uchar buf (Uchar.of_int n);
|
||||||
String (Buffer.contents buf)
|
String (Buffer.contents buf)
|
||||||
| _ -> raise (Eval_error "char-from-code: 1 arg"));
|
| _ -> raise (Eval_error "char-from-code: 1 arg"));
|
||||||
register "char-at" (fun args ->
|
register "char-at" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [String s; Number n] ->
|
| [String s; n] ->
|
||||||
let i = int_of_float n in
|
let i = as_int n in
|
||||||
if i >= 0 && i < String.length s then
|
if i >= 0 && i < String.length s then
|
||||||
String (String.make 1 s.[i])
|
String (String.make 1 s.[i])
|
||||||
else Nil
|
else Nil
|
||||||
| _ -> raise (Eval_error "char-at: string and index"));
|
| _ -> raise (Eval_error "char-at: string and index"));
|
||||||
register "char-code" (fun args ->
|
register "char-code" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [String s] when String.length s > 0 -> Number (float_of_int (Char.code s.[0]))
|
| [String s] when String.length s > 0 -> Integer (Char.code s.[0])
|
||||||
| _ -> raise (Eval_error "char-code: 1 non-empty string arg"));
|
| _ -> raise (Eval_error "char-code: 1 non-empty string arg"));
|
||||||
register "parse-number" (fun args ->
|
register "parse-number" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [String s] ->
|
| [String s] ->
|
||||||
(try Number (float_of_string s)
|
let has_dec = String.contains s '.' in
|
||||||
with Failure _ -> Nil)
|
let has_exp = String.contains s 'e' || String.contains s 'E' in
|
||||||
|
if has_dec || has_exp then
|
||||||
|
(try Number (float_of_string s) with Failure _ -> Nil)
|
||||||
|
else
|
||||||
|
(match int_of_string_opt s with
|
||||||
|
| Some n -> Integer n
|
||||||
|
| None -> (try Number (float_of_string s) with Failure _ -> Nil))
|
||||||
| _ -> raise (Eval_error "parse-number: 1 string arg"));
|
| _ -> raise (Eval_error "parse-number: 1 string arg"));
|
||||||
|
|
||||||
(* === Regex (PCRE-compatible — same syntax as JS RegExp) === *)
|
(* === Regex (PCRE-compatible — same syntax as JS RegExp) === *)
|
||||||
@@ -621,17 +706,17 @@ let () =
|
|||||||
register "list" (fun args -> ListRef (ref args));
|
register "list" (fun args -> ListRef (ref args));
|
||||||
register "len" (fun args ->
|
register "len" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [List l] | [ListRef { contents = l }] -> Number (float_of_int (List.length l))
|
| [List l] | [ListRef { contents = l }] -> Integer (List.length l)
|
||||||
| [String s] -> Number (float_of_int (String.length s))
|
| [String s] -> Integer (String.length s)
|
||||||
| [Dict d] -> Number (float_of_int (Hashtbl.length d))
|
| [Dict d] -> Integer (Hashtbl.length d)
|
||||||
| [Nil] | [Bool false] -> Number 0.0
|
| [Nil] | [Bool false] -> Integer 0
|
||||||
| [Bool true] -> Number 1.0
|
| [Bool true] -> Integer 1
|
||||||
| [Number _] -> Number 1.0
|
| [Number _] | [Integer _] -> Integer 1
|
||||||
| [RawHTML s] -> Number (float_of_int (String.length s))
|
| [RawHTML s] -> Integer (String.length s)
|
||||||
| [SxExpr s] -> Number (float_of_int (String.length s))
|
| [SxExpr s] -> Integer (String.length s)
|
||||||
| [Spread pairs] -> Number (float_of_int (List.length pairs))
|
| [Spread pairs] -> Integer (List.length pairs)
|
||||||
| [Component _] | [Island _] | [Lambda _] | [NativeFn _]
|
| [Component _] | [Island _] | [Lambda _] | [NativeFn _]
|
||||||
| [Macro _] | [Thunk _] | [Keyword _] | [Symbol _] -> Number 0.0
|
| [Macro _] | [Thunk _] | [Keyword _] | [Symbol _] -> Integer 0
|
||||||
| _ -> raise (Eval_error (Printf.sprintf "len: %d args"
|
| _ -> raise (Eval_error (Printf.sprintf "len: %d args"
|
||||||
(List.length args))));
|
(List.length args))));
|
||||||
register "length" (Hashtbl.find primitives "len");
|
register "length" (Hashtbl.find primitives "len");
|
||||||
@@ -658,10 +743,10 @@ let () =
|
|||||||
| _ -> raise (Eval_error "init: 1 list arg"));
|
| _ -> raise (Eval_error "init: 1 list arg"));
|
||||||
register "nth" (fun args ->
|
register "nth" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
|
| [List l; n] | [ListRef { contents = l }; n] ->
|
||||||
(try List.nth l (int_of_float n) with _ -> Nil)
|
(try List.nth l (as_int n) with _ -> Nil)
|
||||||
| [String s; Number n] ->
|
| [String s; n] ->
|
||||||
let i = int_of_float n in
|
let i = as_int n in
|
||||||
if i >= 0 && i < String.length s then String (String.make 1 s.[i])
|
if i >= 0 && i < String.length s then String (String.make 1 s.[i])
|
||||||
else Nil
|
else Nil
|
||||||
| _ -> raise (Eval_error "nth: list/string and number"));
|
| _ -> raise (Eval_error "nth: list/string and number"));
|
||||||
@@ -707,7 +792,10 @@ let () =
|
|||||||
let safe_eq a b =
|
let safe_eq a b =
|
||||||
a == b ||
|
a == b ||
|
||||||
(match a, b with
|
(match a, b with
|
||||||
|
| Integer x, Integer y -> x = y
|
||||||
| Number x, Number y -> x = y
|
| Number x, Number y -> x = y
|
||||||
|
| Integer x, Number y -> float_of_int x = y
|
||||||
|
| Number x, Integer y -> x = float_of_int y
|
||||||
| String x, String y -> x = y
|
| String x, String y -> x = y
|
||||||
| Bool x, Bool y -> x = y
|
| Bool x, Bool y -> x = y
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
@@ -729,33 +817,45 @@ let () =
|
|||||||
| _ -> raise (Eval_error "contains?: 2 args"));
|
| _ -> raise (Eval_error "contains?: 2 args"));
|
||||||
register "range" (fun args ->
|
register "range" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Number stop] ->
|
| [stop_v] ->
|
||||||
let n = int_of_float stop in
|
let n = as_int stop_v in
|
||||||
List (List.init (max 0 n) (fun i -> Number (float_of_int i)))
|
List (List.init (max 0 n) (fun i -> Integer i))
|
||||||
| [Number start; Number stop] ->
|
| [start_v; stop_v] ->
|
||||||
let s = int_of_float start and e = int_of_float stop in
|
let s = as_int start_v and e = as_int stop_v in
|
||||||
let len = max 0 (e - s) in
|
let len = max 0 (e - s) in
|
||||||
List (List.init len (fun i -> Number (float_of_int (s + i))))
|
List (List.init len (fun i -> Integer (s + i)))
|
||||||
| [Number start; Number stop; Number step] ->
|
| [start_v; stop_v; step_v] ->
|
||||||
let s = start and e = stop and st = step in
|
(match start_v, stop_v, step_v with
|
||||||
if st = 0.0 then List []
|
| Integer s, Integer e, Integer st ->
|
||||||
else
|
if st = 0 then List []
|
||||||
let items = ref [] in
|
else
|
||||||
let i = ref s in
|
let items = ref [] in
|
||||||
if st > 0.0 then
|
let i = ref s in
|
||||||
(while !i < e do items := Number !i :: !items; i := !i +. st done)
|
if st > 0 then
|
||||||
else
|
(while !i < e do items := Integer !i :: !items; i := !i + st done)
|
||||||
(while !i > e do items := Number !i :: !items; i := !i +. st done);
|
else
|
||||||
List (List.rev !items)
|
(while !i > e do items := Integer !i :: !items; i := !i + st done);
|
||||||
|
List (List.rev !items)
|
||||||
|
| _ ->
|
||||||
|
let s = as_number start_v and e = as_number stop_v and st = as_number step_v in
|
||||||
|
if st = 0.0 then List []
|
||||||
|
else
|
||||||
|
let items = ref [] in
|
||||||
|
let i = ref s in
|
||||||
|
if st > 0.0 then
|
||||||
|
(while !i < e do items := Number !i :: !items; i := !i +. st done)
|
||||||
|
else
|
||||||
|
(while !i > e do items := Number !i :: !items; i := !i +. st done);
|
||||||
|
List (List.rev !items))
|
||||||
| _ -> raise (Eval_error "range: 1-3 args"));
|
| _ -> raise (Eval_error "range: 1-3 args"));
|
||||||
register "slice" (fun args ->
|
register "slice" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [(List l | ListRef { contents = l }); Number start] ->
|
| [(List l | ListRef { contents = l }); start_v] ->
|
||||||
let i = max 0 (int_of_float start) in
|
let i = max 0 (as_int start_v) in
|
||||||
let rec drop n = function _ :: xs when n > 0 -> drop (n-1) xs | l -> l in
|
let rec drop n = function _ :: xs when n > 0 -> drop (n-1) xs | l -> l in
|
||||||
List (drop i l)
|
List (drop i l)
|
||||||
| [(List l | ListRef { contents = l }); Number start; Number end_] ->
|
| [(List l | ListRef { contents = l }); start_v; end_v] ->
|
||||||
let i = max 0 (int_of_float start) and j = int_of_float end_ in
|
let i = max 0 (as_int start_v) and j = as_int end_v in
|
||||||
let len = List.length l in
|
let len = List.length l in
|
||||||
let j = min j len in
|
let j = min j len in
|
||||||
let rec take_range idx = function
|
let rec take_range idx = function
|
||||||
@@ -765,11 +865,11 @@ let () =
|
|||||||
else if idx >= i then x :: take_range (idx+1) xs
|
else if idx >= i then x :: take_range (idx+1) xs
|
||||||
else take_range (idx+1) xs
|
else take_range (idx+1) xs
|
||||||
in List (take_range 0 l)
|
in List (take_range 0 l)
|
||||||
| [String s; Number start] ->
|
| [String s; start_v] ->
|
||||||
let i = max 0 (int_of_float start) in
|
let i = max 0 (as_int start_v) in
|
||||||
String (String.sub s i (max 0 (String.length s - i)))
|
String (String.sub s i (max 0 (String.length s - i)))
|
||||||
| [String s; Number start; Number end_] ->
|
| [String s; start_v; end_v] ->
|
||||||
let i = max 0 (int_of_float start) and j = int_of_float end_ in
|
let i = max 0 (as_int start_v) and j = as_int end_v in
|
||||||
let sl = String.length s in
|
let sl = String.length s in
|
||||||
let j = min j sl in
|
let j = min j sl in
|
||||||
String (String.sub s i (max 0 (j - i)))
|
String (String.sub s i (max 0 (j - i)))
|
||||||
@@ -798,24 +898,24 @@ let () =
|
|||||||
| _ -> raise (Eval_error "zip-pairs: 1 list"));
|
| _ -> raise (Eval_error "zip-pairs: 1 list"));
|
||||||
register "take" (fun args ->
|
register "take" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [(List l | ListRef { contents = l }); Number n] ->
|
| [(List l | ListRef { contents = l }); n] ->
|
||||||
let rec take_n i = function
|
let rec take_n i = function
|
||||||
| x :: xs when i > 0 -> x :: take_n (i-1) xs
|
| x :: xs when i > 0 -> x :: take_n (i-1) xs
|
||||||
| _ -> []
|
| _ -> []
|
||||||
in List (take_n (int_of_float n) l)
|
in List (take_n (as_int n) l)
|
||||||
| _ -> raise (Eval_error "take: list and number"));
|
| _ -> raise (Eval_error "take: list and number"));
|
||||||
register "drop" (fun args ->
|
register "drop" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [(List l | ListRef { contents = l }); Number n] ->
|
| [(List l | ListRef { contents = l }); n] ->
|
||||||
let rec drop_n i = function
|
let rec drop_n i = function
|
||||||
| _ :: xs when i > 0 -> drop_n (i-1) xs
|
| _ :: xs when i > 0 -> drop_n (i-1) xs
|
||||||
| l -> l
|
| l -> l
|
||||||
in List (drop_n (int_of_float n) l)
|
in List (drop_n (as_int n) l)
|
||||||
| _ -> raise (Eval_error "drop: list and number"));
|
| _ -> raise (Eval_error "drop: list and number"));
|
||||||
register "chunk-every" (fun args ->
|
register "chunk-every" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [(List l | ListRef { contents = l }); Number n] ->
|
| [(List l | ListRef { contents = l }); n] ->
|
||||||
let size = int_of_float n in
|
let size = as_int n in
|
||||||
let rec go = function
|
let rec go = function
|
||||||
| [] -> []
|
| [] -> []
|
||||||
| l ->
|
| l ->
|
||||||
@@ -855,8 +955,9 @@ let () =
|
|||||||
match args with
|
match args with
|
||||||
| [Dict d; String k] -> dict_get d k
|
| [Dict d; String k] -> dict_get d k
|
||||||
| [Dict d; Keyword k] -> dict_get d k
|
| [Dict d; Keyword k] -> dict_get d k
|
||||||
| [List l; Number n] | [ListRef { contents = l }; Number n] ->
|
| [List l; n] | [ListRef { contents = l }; n]
|
||||||
(try List.nth l (int_of_float n) with _ -> Nil)
|
when (match n with Number _ | Integer _ -> true | _ -> false) ->
|
||||||
|
(try List.nth l (as_int n) with _ -> Nil)
|
||||||
| [Nil; _] -> Nil (* nil.anything → nil *)
|
| [Nil; _] -> Nil (* nil.anything → nil *)
|
||||||
| [_; _] -> Nil (* type mismatch → nil (matches JS/Python behavior) *)
|
| [_; _] -> Nil (* type mismatch → nil (matches JS/Python behavior) *)
|
||||||
| _ -> Nil);
|
| _ -> Nil);
|
||||||
@@ -897,8 +998,8 @@ let () =
|
|||||||
register "mutable-list" (fun _args -> ListRef (ref []));
|
register "mutable-list" (fun _args -> ListRef (ref []));
|
||||||
register "set-nth!" (fun args ->
|
register "set-nth!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [ListRef r; Number n; v] ->
|
| [ListRef r; idx; v] ->
|
||||||
let i = int_of_float n in
|
let i = as_int idx in
|
||||||
let l = !r in
|
let l = !r in
|
||||||
r := List.mapi (fun j x -> if j = i then v else x) l;
|
r := List.mapi (fun j x -> if j = i then v else x) l;
|
||||||
Nil
|
Nil
|
||||||
@@ -1025,15 +1126,15 @@ let () =
|
|||||||
register "identical?" (fun args ->
|
register "identical?" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [a; b] ->
|
| [a; b] ->
|
||||||
(* Physical identity for reference types, structural for values.
|
|
||||||
Numbers/strings/booleans from different constant pools must
|
|
||||||
compare equal when their values match. *)
|
|
||||||
let identical = match a, b with
|
let identical = match a, b with
|
||||||
|
| Integer x, Integer y -> x = y
|
||||||
| Number x, Number y -> x = y
|
| Number x, Number y -> x = y
|
||||||
| String x, String y -> x = y (* String.equal *)
|
| Integer x, Number y -> float_of_int x = y
|
||||||
|
| Number x, Integer y -> x = float_of_int y
|
||||||
|
| String x, String y -> x = y
|
||||||
| Bool x, Bool y -> x = y
|
| Bool x, Bool y -> x = y
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
| _ -> a == b (* reference identity for dicts, lists, etc. *)
|
| _ -> a == b
|
||||||
in Bool identical
|
in Bool identical
|
||||||
| _ -> raise (Eval_error "identical?: 2 args"));
|
| _ -> raise (Eval_error "identical?: 2 args"));
|
||||||
register "make-spread" (fun args ->
|
register "make-spread" (fun args ->
|
||||||
@@ -1071,7 +1172,7 @@ let () =
|
|||||||
register "map-indexed" (fun args ->
|
register "map-indexed" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [f; (List items | ListRef { contents = items })] ->
|
| [f; (List items | ListRef { contents = items })] ->
|
||||||
List (List.mapi (fun i x -> call_any f [Number (float_of_int i); x]) items)
|
List (List.mapi (fun i x -> call_any f [Integer i; x]) items)
|
||||||
| [_; Nil] -> List []
|
| [_; Nil] -> List []
|
||||||
| _ -> raise (Eval_error "map-indexed: expected (fn list)"));
|
| _ -> raise (Eval_error "map-indexed: expected (fn list)"));
|
||||||
register "filter" (fun args ->
|
register "filter" (fun args ->
|
||||||
@@ -1114,26 +1215,26 @@ let () =
|
|||||||
(* ---- VM stack primitives (vm.sx platform interface) ---- *)
|
(* ---- VM stack primitives (vm.sx platform interface) ---- *)
|
||||||
register "make-vm-stack" (fun args ->
|
register "make-vm-stack" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Number n] -> ListRef (ref (List.init (int_of_float n) (fun _ -> Nil)))
|
| [n] -> ListRef (ref (List.init (as_int n) (fun _ -> Nil)))
|
||||||
| _ -> raise (Eval_error "make-vm-stack: expected (size)"));
|
| _ -> raise (Eval_error "make-vm-stack: expected (size)"));
|
||||||
register "vm-stack-get" (fun args ->
|
register "vm-stack-get" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [ListRef r; Number n] -> List.nth !r (int_of_float n)
|
| [ListRef r; n] -> List.nth !r (as_int n)
|
||||||
| _ -> raise (Eval_error "vm-stack-get: expected (stack idx)"));
|
| _ -> raise (Eval_error "vm-stack-get: expected (stack idx)"));
|
||||||
register "vm-stack-set!" (fun args ->
|
register "vm-stack-set!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [ListRef r; Number n; v] ->
|
| [ListRef r; n; v] ->
|
||||||
let i = int_of_float n in
|
let i = as_int n in
|
||||||
r := List.mapi (fun j x -> if j = i then v else x) !r; Nil
|
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)"));
|
| _ -> raise (Eval_error "vm-stack-set!: expected (stack idx val)"));
|
||||||
register "vm-stack-length" (fun args ->
|
register "vm-stack-length" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [ListRef r] -> Number (float_of_int (List.length !r))
|
| [ListRef r] -> Integer (List.length !r)
|
||||||
| _ -> raise (Eval_error "vm-stack-length: expected (stack)"));
|
| _ -> raise (Eval_error "vm-stack-length: expected (stack)"));
|
||||||
register "vm-stack-copy!" (fun args ->
|
register "vm-stack-copy!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [ListRef src; ListRef dst; Number n] ->
|
| [ListRef src; ListRef dst; n] ->
|
||||||
let count = int_of_float n in
|
let count = as_int n in
|
||||||
let src_items = !src 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
|
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)"));
|
| _ -> raise (Eval_error "vm-stack-copy!: expected (src dst count)"));
|
||||||
@@ -1215,28 +1316,28 @@ let () =
|
|||||||
(* R7RS vectors — mutable fixed-size arrays *)
|
(* R7RS vectors — mutable fixed-size arrays *)
|
||||||
register "make-vector" (fun args ->
|
register "make-vector" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Number n] -> Vector (Array.make (int_of_float n) Nil)
|
| [n] -> Vector (Array.make (as_int n) Nil)
|
||||||
| [Number n; fill] -> Vector (Array.make (int_of_float n) fill)
|
| [n; fill] -> Vector (Array.make (as_int n) fill)
|
||||||
| _ -> raise (Eval_error "make-vector: expected (length) or (length fill)"));
|
| _ -> raise (Eval_error "make-vector: expected (length) or (length fill)"));
|
||||||
register "vector" (fun args -> Vector (Array.of_list args));
|
register "vector" (fun args -> Vector (Array.of_list args));
|
||||||
register "vector?" (fun args ->
|
register "vector?" (fun args ->
|
||||||
match args with [Vector _] -> Bool true | [_] -> Bool false
|
match args with [Vector _] -> Bool true | [_] -> Bool false
|
||||||
| _ -> raise (Eval_error "vector?: 1 arg"));
|
| _ -> raise (Eval_error "vector?: 1 arg"));
|
||||||
register "vector-length" (fun args ->
|
register "vector-length" (fun args ->
|
||||||
match args with [Vector arr] -> Number (float_of_int (Array.length arr))
|
match args with [Vector arr] -> Integer (Array.length arr)
|
||||||
| _ -> raise (Eval_error "vector-length: expected vector"));
|
| _ -> raise (Eval_error "vector-length: expected vector"));
|
||||||
register "vector-ref" (fun args ->
|
register "vector-ref" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Vector arr; Number n] ->
|
| [Vector arr; n] ->
|
||||||
let i = int_of_float n in
|
let i = as_int n in
|
||||||
if i < 0 || i >= Array.length arr then
|
if i < 0 || i >= Array.length arr then
|
||||||
raise (Eval_error (Printf.sprintf "vector-ref: index %d out of bounds (length %d)" i (Array.length arr)));
|
raise (Eval_error (Printf.sprintf "vector-ref: index %d out of bounds (length %d)" i (Array.length arr)));
|
||||||
arr.(i)
|
arr.(i)
|
||||||
| _ -> raise (Eval_error "vector-ref: expected (vector index)"));
|
| _ -> raise (Eval_error "vector-ref: expected (vector index)"));
|
||||||
register "vector-set!" (fun args ->
|
register "vector-set!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Vector arr; Number n; v] ->
|
| [Vector arr; n; v] ->
|
||||||
let i = int_of_float n in
|
let i = as_int n in
|
||||||
if i < 0 || i >= Array.length arr then
|
if i < 0 || i >= Array.length arr then
|
||||||
raise (Eval_error (Printf.sprintf "vector-set!: index %d out of bounds (length %d)" i (Array.length arr)));
|
raise (Eval_error (Printf.sprintf "vector-set!: index %d out of bounds (length %d)" i (Array.length arr)));
|
||||||
arr.(i) <- v; Nil
|
arr.(i) <- v; Nil
|
||||||
@@ -1256,13 +1357,13 @@ let () =
|
|||||||
register "vector-copy" (fun args ->
|
register "vector-copy" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Vector arr] -> Vector (Array.copy arr)
|
| [Vector arr] -> Vector (Array.copy arr)
|
||||||
| [Vector arr; Number s] ->
|
| [Vector arr; s] ->
|
||||||
let start = int_of_float s in
|
let start = as_int s in
|
||||||
let len = Array.length arr - start in
|
let len = Array.length arr - start in
|
||||||
if len <= 0 then Vector [||] else Vector (Array.sub arr start len)
|
if len <= 0 then Vector [||] else Vector (Array.sub arr start len)
|
||||||
| [Vector arr; Number s; Number e] ->
|
| [Vector arr; s; e] ->
|
||||||
let start = int_of_float s in
|
let start = as_int s in
|
||||||
let stop = min (int_of_float e) (Array.length arr) in
|
let stop = min (as_int e) (Array.length arr) in
|
||||||
let len = stop - start in
|
let len = stop - start in
|
||||||
if len <= 0 then Vector [||] else Vector (Array.sub arr start len)
|
if len <= 0 then Vector [||] else Vector (Array.sub arr start len)
|
||||||
| _ -> raise (Eval_error "vector-copy: expected (vector) or (vector start) or (vector start end)"));
|
| _ -> raise (Eval_error "vector-copy: expected (vector) or (vector start) or (vector start end)"));
|
||||||
|
|||||||
@@ -43,9 +43,10 @@ type env = {
|
|||||||
|
|
||||||
and value =
|
and value =
|
||||||
| Nil
|
| Nil
|
||||||
| Bool of bool
|
| Bool of bool
|
||||||
| Number of float
|
| Integer of int (** Exact integer — distinct from inexact float. *)
|
||||||
| String of string
|
| Number of float (** Inexact float. *)
|
||||||
|
| String of string
|
||||||
| Symbol of string
|
| Symbol of string
|
||||||
| Keyword of string
|
| Keyword of string
|
||||||
| List of value list
|
| List of value list
|
||||||
@@ -392,6 +393,7 @@ let format_number n =
|
|||||||
|
|
||||||
let value_to_string = function
|
let value_to_string = function
|
||||||
| String s -> s | Symbol s -> s | Keyword k -> k
|
| String s -> s | Symbol s -> s | Keyword k -> k
|
||||||
|
| Integer n -> string_of_int n
|
||||||
| Number n -> format_number n
|
| Number n -> format_number n
|
||||||
| Bool true -> "true" | Bool false -> "false"
|
| Bool true -> "true" | Bool false -> "false"
|
||||||
| Nil -> "" | _ -> "<value>"
|
| Nil -> "" | _ -> "<value>"
|
||||||
@@ -461,6 +463,7 @@ let make_keyword name = Keyword (value_to_string name)
|
|||||||
let type_of = function
|
let type_of = function
|
||||||
| Nil -> "nil"
|
| Nil -> "nil"
|
||||||
| Bool _ -> "boolean"
|
| Bool _ -> "boolean"
|
||||||
|
| Integer _ -> "number"
|
||||||
| Number _ -> "number"
|
| Number _ -> "number"
|
||||||
| String _ -> "string"
|
| String _ -> "string"
|
||||||
| Symbol _ -> "symbol"
|
| Symbol _ -> "symbol"
|
||||||
@@ -616,6 +619,7 @@ let thunk_env = function
|
|||||||
(** {1 Record operations} *)
|
(** {1 Record operations} *)
|
||||||
|
|
||||||
let val_to_int = function
|
let val_to_int = function
|
||||||
|
| Integer n -> n
|
||||||
| Number n -> int_of_float n
|
| Number n -> int_of_float n
|
||||||
| v -> raise (Eval_error ("Expected number, got " ^ type_of v))
|
| v -> raise (Eval_error ("Expected number, got " ^ type_of v))
|
||||||
|
|
||||||
@@ -777,6 +781,7 @@ let rec inspect = function
|
|||||||
| Nil -> "nil"
|
| Nil -> "nil"
|
||||||
| Bool true -> "true"
|
| Bool true -> "true"
|
||||||
| Bool false -> "false"
|
| Bool false -> "false"
|
||||||
|
| Integer n -> string_of_int n
|
||||||
| Number n -> format_number n
|
| Number n -> format_number n
|
||||||
| String s ->
|
| String s ->
|
||||||
let buf = Buffer.create (String.length s + 2) in
|
let buf = Buffer.create (String.length s + 2) in
|
||||||
|
|||||||
@@ -185,7 +185,8 @@ let code_from_value v =
|
|||||||
| Some _ as r -> r | None -> Hashtbl.find_opt d k2 in
|
| Some _ as r -> r | None -> Hashtbl.find_opt d k2 in
|
||||||
let bc_list = match find2 "bytecode" "vc-bytecode" with
|
let bc_list = match find2 "bytecode" "vc-bytecode" with
|
||||||
| Some (List l | ListRef { contents = l }) ->
|
| Some (List l | ListRef { contents = l }) ->
|
||||||
Array.of_list (List.map (fun x -> match x with Number n -> int_of_float n | _ -> 0) l)
|
Array.of_list (List.map (fun x -> match x with
|
||||||
|
| Integer n -> n | Number n -> int_of_float n | _ -> 0) l)
|
||||||
| _ -> [||]
|
| _ -> [||]
|
||||||
in
|
in
|
||||||
let entries = match find2 "constants" "vc-constants" with
|
let entries = match find2 "constants" "vc-constants" with
|
||||||
@@ -198,10 +199,10 @@ let code_from_value v =
|
|||||||
| _ -> entry
|
| _ -> entry
|
||||||
) entries in
|
) entries in
|
||||||
let arity = match find2 "arity" "vc-arity" with
|
let arity = match find2 "arity" "vc-arity" with
|
||||||
| Some (Number n) -> int_of_float n | _ -> 0
|
| Some (Integer n) -> n | Some (Number n) -> int_of_float n | _ -> 0
|
||||||
in
|
in
|
||||||
let rest_arity = match find2 "rest-arity" "vc-rest-arity" with
|
let rest_arity = match find2 "rest-arity" "vc-rest-arity" with
|
||||||
| Some (Number n) -> int_of_float n | _ -> -1
|
| Some (Integer n) -> n | Some (Number n) -> int_of_float n | _ -> -1
|
||||||
in
|
in
|
||||||
(* Compute locals from bytecode: scan for highest LOCAL_GET/LOCAL_SET slot.
|
(* Compute locals from bytecode: scan for highest LOCAL_GET/LOCAL_SET slot.
|
||||||
The compiler's arity may undercount when nested lets add many locals. *)
|
The compiler's arity may undercount when nested lets add many locals. *)
|
||||||
@@ -749,10 +750,7 @@ and run vm =
|
|||||||
| _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b])
|
| _ -> (Hashtbl.find Sx_primitives.primitives "/") [a; b])
|
||||||
| 164 (* OP_EQ *) ->
|
| 164 (* OP_EQ *) ->
|
||||||
let b = pop vm and a = pop vm in
|
let b = pop vm and a = pop vm in
|
||||||
let rec norm = function
|
push vm ((Hashtbl.find Sx_primitives.primitives "=") [a; b])
|
||||||
| ListRef { contents = l } -> List (List.map norm l)
|
|
||||||
| List l -> List (List.map norm l) | v -> v in
|
|
||||||
push vm (Bool (norm a = norm b))
|
|
||||||
| 165 (* OP_LT *) ->
|
| 165 (* OP_LT *) ->
|
||||||
let b = pop vm and a = pop vm in
|
let b = pop vm and a = pop vm in
|
||||||
push vm (match a, b with
|
push vm (match a, b with
|
||||||
@@ -771,10 +769,10 @@ and run vm =
|
|||||||
| 168 (* OP_LEN *) ->
|
| 168 (* OP_LEN *) ->
|
||||||
let v = pop vm in
|
let v = pop vm in
|
||||||
push vm (match v with
|
push vm (match v with
|
||||||
| List l | ListRef { contents = l } -> Number (float_of_int (List.length l))
|
| List l | ListRef { contents = l } -> Integer (List.length l)
|
||||||
| String s -> Number (float_of_int (String.length s))
|
| String s -> Integer (String.length s)
|
||||||
| Dict d -> Number (float_of_int (Hashtbl.length d))
|
| Dict d -> Integer (Hashtbl.length d)
|
||||||
| Nil -> Number 0.0
|
| Nil -> Integer 0
|
||||||
| _ -> (Hashtbl.find Sx_primitives.primitives "len") [v])
|
| _ -> (Hashtbl.find Sx_primitives.primitives "len") [v])
|
||||||
| 169 (* OP_FIRST *) ->
|
| 169 (* OP_FIRST *) ->
|
||||||
let v = pop vm in
|
let v = pop vm in
|
||||||
|
|||||||
221
spec/tests/test-numeric-tower.sx
Normal file
221
spec/tests/test-numeric-tower.sx
Normal file
@@ -0,0 +1,221 @@
|
|||||||
|
|
||||||
|
;; ==========================================================================
|
||||||
|
;; test-numeric-tower.sx — Numeric tower: Integer vs Float distinction
|
||||||
|
;;
|
||||||
|
;; Tests for float contagion, integer arithmetic, predicates,
|
||||||
|
;; coercions, parsing, and rendering.
|
||||||
|
;;
|
||||||
|
;; Note: Use fractional floats (1.5, 3.14) or exact->inexact for round floats,
|
||||||
|
;; since the SX serializer renders Number 1.0 as "1" (int form).
|
||||||
|
;; ==========================================================================
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Integer arithmetic — result stays Integer when all args are Integer
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:int-arithmetic"
|
||||||
|
(deftest "int + int = int" (assert (integer? (+ 1 2))))
|
||||||
|
(deftest "int + int value" (assert= (+ 1 2) 3))
|
||||||
|
(deftest "int - int = int" (assert (integer? (- 10 3))))
|
||||||
|
(deftest "int - int value" (assert= (- 10 3) 7))
|
||||||
|
(deftest "int * int = int" (assert (integer? (* 4 5))))
|
||||||
|
(deftest "int * int value" (assert= (* 4 5) 20))
|
||||||
|
(deftest "zero identity" (assert= (+ 0 0) 0))
|
||||||
|
(deftest "negative int" (assert= (- 0 5) -5))
|
||||||
|
(deftest
|
||||||
|
"int negation is int"
|
||||||
|
(assert (integer? (- 0 7))))
|
||||||
|
(deftest
|
||||||
|
"large int product"
|
||||||
|
(assert= (* 100 100) 10000)))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Float contagion — any float arg promotes result to float
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:float-contagion"
|
||||||
|
(deftest "int + float = float" (assert (float? (+ 1 1.5))))
|
||||||
|
(deftest "int + float value" (assert= (+ 1 1.5) 2.5))
|
||||||
|
(deftest "float + int = float" (assert (float? (+ 1.5 2))))
|
||||||
|
(deftest "float + float = float" (assert (float? (+ 1.5 2.5))))
|
||||||
|
(deftest "int * float = float" (assert (float? (* 2 1.5))))
|
||||||
|
(deftest "int * float value" (assert= (* 2 1.5) 3))
|
||||||
|
(deftest "int - float = float" (assert (float? (- 5 2.5))))
|
||||||
|
(deftest "float - int = float" (assert (float? (- 5.5 2))))
|
||||||
|
(deftest
|
||||||
|
"three args with float"
|
||||||
|
(assert (float? (+ 1 2 3.5))))
|
||||||
|
(deftest
|
||||||
|
"exact->inexact promotes to float"
|
||||||
|
(assert (float? (exact->inexact 5)))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Division always returns float
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:division"
|
||||||
|
(deftest "int / int = float" (assert (float? (/ 6 2))))
|
||||||
|
(deftest "exact division value" (assert= (/ 6 2) 3))
|
||||||
|
(deftest "inexact division" (assert= (/ 1 4) 0.25))
|
||||||
|
(deftest "float / float = float" (assert (float? (/ 3.5 2.5)))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Type predicates
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:predicates"
|
||||||
|
(deftest "integer? on int" (assert (integer? 42)))
|
||||||
|
(deftest "integer? on negative" (assert (integer? -7)))
|
||||||
|
(deftest "integer? on zero" (assert (integer? 0)))
|
||||||
|
(deftest
|
||||||
|
"integer? on float-int"
|
||||||
|
(assert (integer? (exact->inexact 2))))
|
||||||
|
(deftest "integer? on fractional float" (assert (not (integer? 1.5))))
|
||||||
|
(deftest "float? on 1.5" (assert (float? 1.5)))
|
||||||
|
(deftest
|
||||||
|
"float? on exact->inexact"
|
||||||
|
(assert (float? (exact->inexact 2))))
|
||||||
|
(deftest "float? on int" (assert (not (float? 42))))
|
||||||
|
(deftest "number? on int" (assert (number? 42)))
|
||||||
|
(deftest "number? on float" (assert (number? 3.14)))
|
||||||
|
(deftest "number? on string" (assert (not (number? "42"))))
|
||||||
|
(deftest "exact? on int" (assert (exact? 1)))
|
||||||
|
(deftest
|
||||||
|
"exact? on exact->inexact"
|
||||||
|
(assert (not (exact? (exact->inexact 1)))))
|
||||||
|
(deftest "inexact? on 1.5" (assert (inexact? 1.5)))
|
||||||
|
(deftest "inexact? on int" (assert (not (inexact? 3)))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Coercions
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:coercions"
|
||||||
|
(deftest "exact->inexact int" (assert= (exact->inexact 3) 3))
|
||||||
|
(deftest
|
||||||
|
"exact->inexact produces float"
|
||||||
|
(assert (float? (exact->inexact 5))))
|
||||||
|
(deftest
|
||||||
|
"exact->inexact float passthrough"
|
||||||
|
(assert= (exact->inexact 1.5) 1.5))
|
||||||
|
(deftest "inexact->exact 1.5" (assert= (inexact->exact 1.5) 2))
|
||||||
|
(deftest
|
||||||
|
"inexact->exact produces int"
|
||||||
|
(assert (integer? (inexact->exact (exact->inexact 4)))))
|
||||||
|
(deftest "inexact->exact 2.7" (assert= (inexact->exact 2.7) 3))
|
||||||
|
(deftest
|
||||||
|
"inexact->exact int passthrough"
|
||||||
|
(assert= (inexact->exact 5) 5)))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; floor / ceiling / truncate / round — return Integer for floats
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:rounding"
|
||||||
|
(deftest "floor 3.7" (assert= (floor 3.7) 3))
|
||||||
|
(deftest "floor produces int" (assert (integer? (floor 3.7))))
|
||||||
|
(deftest "floor negative" (assert= (floor -2.3) -3))
|
||||||
|
(deftest "truncate 3.9" (assert= (truncate 3.9) 3))
|
||||||
|
(deftest "truncate negative" (assert= (truncate -3.9) -3))
|
||||||
|
(deftest "truncate produces int" (assert (integer? (truncate 3.9))))
|
||||||
|
(deftest "round 2.3 down" (assert= (round 2.3) 2))
|
||||||
|
(deftest "round produces int" (assert (integer? (round 2.3))))
|
||||||
|
(deftest
|
||||||
|
"floor of int passthrough"
|
||||||
|
(assert= (floor 5) 5))
|
||||||
|
(deftest "floor of int stays int" (assert (integer? (floor 5)))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; parse-number distinguishes int vs float strings
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:parse-number"
|
||||||
|
(deftest
|
||||||
|
"parse-number int string"
|
||||||
|
(assert= (parse-number "42") 42))
|
||||||
|
(deftest
|
||||||
|
"parse-number int is integer?"
|
||||||
|
(assert (integer? (parse-number "42"))))
|
||||||
|
(deftest "parse-number 3.14" (assert= (parse-number "3.14") 3.14))
|
||||||
|
(deftest
|
||||||
|
"parse-number float is float?"
|
||||||
|
(assert (float? (parse-number "3.14"))))
|
||||||
|
(deftest
|
||||||
|
"parse-number 1.5 is float?"
|
||||||
|
(assert (float? (parse-number "1.5"))))
|
||||||
|
(deftest
|
||||||
|
"parse-number negative int"
|
||||||
|
(assert= (parse-number "-5") -5))
|
||||||
|
(deftest
|
||||||
|
"parse-number negative int is integer?"
|
||||||
|
(assert (integer? (parse-number "-5"))))
|
||||||
|
(deftest "parse-int returns integer" (assert (integer? (parse-int "7"))))
|
||||||
|
(deftest "parse-int value" (assert= (parse-int "7") 7)))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; Equality across numeric types
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:equality"
|
||||||
|
(deftest "int = same int" (assert= 5 5))
|
||||||
|
(deftest
|
||||||
|
"int = float eq"
|
||||||
|
(assert (= 1 (exact->inexact 1))))
|
||||||
|
(deftest
|
||||||
|
"float = int eq"
|
||||||
|
(assert (= (exact->inexact 1) 1)))
|
||||||
|
(deftest "int != different int" (assert (!= 1 2)))
|
||||||
|
(deftest "int < float" (assert (< 1 1.5)))
|
||||||
|
(deftest "float > int" (assert (> 2.5 2)))
|
||||||
|
(deftest "int <= float" (assert (<= 2 2.5)))
|
||||||
|
(deftest "int >= int" (assert (>= 3 3))))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; mod / remainder / modulo with integers
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:modulo"
|
||||||
|
(deftest
|
||||||
|
"mod int int = int"
|
||||||
|
(assert (integer? (mod 10 3))))
|
||||||
|
(deftest "mod value" (assert= (mod 10 3) 1))
|
||||||
|
(deftest
|
||||||
|
"remainder int int = int"
|
||||||
|
(assert (integer? (remainder 10 3))))
|
||||||
|
(deftest
|
||||||
|
"remainder value"
|
||||||
|
(assert= (remainder 10 3) 1)))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; min / max with mixed types
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:min-max"
|
||||||
|
(deftest "min two ints" (assert= (min 3 7) 3))
|
||||||
|
(deftest
|
||||||
|
"min int result type"
|
||||||
|
(assert (integer? (min 3 7))))
|
||||||
|
(deftest "max two ints" (assert= (max 3 7) 7))
|
||||||
|
(deftest "min with float" (assert= (min 3 2.5) 2.5))
|
||||||
|
(deftest "max with float" (assert= (max 3 3.5) 3.5)))
|
||||||
|
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
;; str rendering of int vs float
|
||||||
|
;; --------------------------------------------------------------------------
|
||||||
|
|
||||||
|
(defsuite
|
||||||
|
"numeric-tower:stringify"
|
||||||
|
(deftest "str of int" (assert= (str 42) "42"))
|
||||||
|
(deftest "str of negative int" (assert= (str -5) "-5"))
|
||||||
|
(deftest "str of 3.14" (assert= (str 3.14) "3.14"))
|
||||||
|
(deftest "str of 1.5" (assert= (str 1.5) "1.5")))
|
||||||
Reference in New Issue
Block a user