diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index a314c3d0..dc39f830 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -849,6 +849,9 @@ PREAMBLE = '''\ } return true; } + if (a && b && a._rational && b._rational) return a._n === b._n && a._d === b._d; + if (a && a._rational && typeof b === "number") return b === a._n / a._d; + if (b && b._rational && typeof a === "number") return a === b._n / b._d; return false; } @@ -977,10 +980,68 @@ PREAMBLE = '''\ PRIMITIVES_JS_MODULES: dict[str, str] = { "core.arithmetic": ''' // core.arithmetic - PRIMITIVES["+"] = function() { var s = 0; for (var i = 0; i < arguments.length; i++) s += arguments[i]; return s; }; - PRIMITIVES["-"] = function(a, b) { return arguments.length === 1 ? -a : a - b; }; - PRIMITIVES["*"] = function() { var s = 1; for (var i = 0; i < arguments.length; i++) s *= arguments[i]; return s; }; - PRIMITIVES["/"] = function(a, b) { return a / b; }; + function _ratMake(n, d) { + if (d === 0) throw new Error("division by zero"); + var r = new SxRational(n, d); + return r._d === 1 ? r._n : r; + } + function _ratN(x) { return x && x._rational ? x._n : x; } + function _ratD(x) { return x && x._rational ? x._d : 1; } + function _hasFloat(args) { + for (var i = 0; i < args.length; i++) { + var x = args[i]; + if (typeof x === "number" && !Number.isInteger(x)) return true; + } + return false; + } + function _ratToFloat(x) { return x && x._rational ? x._n / x._d : x; } + PRIMITIVES["+"] = function() { + var hasRat = false; + for (var i = 0; i < arguments.length; i++) if (arguments[i] && arguments[i]._rational) { hasRat = true; break; } + if (!hasRat) { var s = 0; for (var i = 0; i < arguments.length; i++) s += arguments[i]; return s; } + if (_hasFloat(arguments)) { var s = 0; for (var i = 0; i < arguments.length; i++) s += _ratToFloat(arguments[i]); return s; } + var an = 0, ad = 1; + for (var i = 0; i < arguments.length; i++) { + var bn = _ratN(arguments[i]), bd = _ratD(arguments[i]); + an = an * bd + bn * ad; ad = ad * bd; + } + return _ratMake(an, ad); + }; + PRIMITIVES["-"] = function() { + if (arguments.length === 0) return 0; + var hasRat = false; + for (var i = 0; i < arguments.length; i++) if (arguments[i] && arguments[i]._rational) { hasRat = true; break; } + if (!hasRat) return arguments.length === 1 ? -arguments[0] : arguments[0] - arguments[1]; + if (_hasFloat(arguments)) { + if (arguments.length === 1) return -_ratToFloat(arguments[0]); + var s = _ratToFloat(arguments[0]); + for (var i = 1; i < arguments.length; i++) s -= _ratToFloat(arguments[i]); + return s; + } + if (arguments.length === 1) { var x = arguments[0]; return x._rational ? _ratMake(-x._n, x._d) : -x; } + var an = _ratN(arguments[0]), ad = _ratD(arguments[0]); + for (var i = 1; i < arguments.length; i++) { + var bn = _ratN(arguments[i]), bd = _ratD(arguments[i]); + an = an * bd - bn * ad; ad = ad * bd; + } + return _ratMake(an, ad); + }; + PRIMITIVES["*"] = function() { + var hasRat = false; + for (var i = 0; i < arguments.length; i++) if (arguments[i] && arguments[i]._rational) { hasRat = true; break; } + if (!hasRat) { var s = 1; for (var i = 0; i < arguments.length; i++) s *= arguments[i]; return s; } + if (_hasFloat(arguments)) { var s = 1; for (var i = 0; i < arguments.length; i++) s *= _ratToFloat(arguments[i]); return s; } + var an = 1, ad = 1; + for (var i = 0; i < arguments.length; i++) { an *= _ratN(arguments[i]); ad *= _ratD(arguments[i]); } + return _ratMake(an, ad); + }; + PRIMITIVES["/"] = function(a, b) { + var aRat = a && a._rational, bRat = b && b._rational; + if (!aRat && !bRat) return a / b; + if (typeof a === "number" && !Number.isInteger(a) || typeof b === "number" && !Number.isInteger(b)) + return _ratToFloat(a) / _ratToFloat(b); + return _ratMake(_ratN(a) * _ratD(b), _ratD(a) * _ratN(b)); + }; PRIMITIVES["mod"] = function(a, b) { return a % b; }; PRIMITIVES["inc"] = function(n) { return n + 1; }; PRIMITIVES["dec"] = function(n) { return n - 1; }; @@ -1000,19 +1061,37 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { PRIMITIVES["pow"] = Math.pow; PRIMITIVES["clamp"] = function(x, lo, hi) { return Math.max(lo, Math.min(hi, x)); }; PRIMITIVES["random-int"] = function(lo, hi) { return Math.floor(Math.random() * (hi - lo + 1)) + lo; }; - PRIMITIVES["exact->inexact"] = function(x) { return x; }; + PRIMITIVES["exact->inexact"] = function(x) { + if (x && x._rational) return x._n / x._d; + return x; + }; PRIMITIVES["inexact->exact"] = Math.round; PRIMITIVES["parse-number"] = function(s) { var n = Number(s); return isNaN(n) ? null : n; }; ''', "core.comparison": ''' // core.comparison + function _ratCmp(a, b) { + return _ratN(a) * _ratD(b) - _ratN(b) * _ratD(a); + } PRIMITIVES["="] = sxEq; PRIMITIVES["!="] = function(a, b) { return !sxEq(a, b); }; - PRIMITIVES["<"] = function(a, b) { return a < b; }; - PRIMITIVES[">"] = function(a, b) { return a > b; }; - PRIMITIVES["<="] = function(a, b) { return a <= b; }; - PRIMITIVES[">="] = function(a, b) { return a >= b; }; + PRIMITIVES["<"] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) < 0; + return a < b; + }; + PRIMITIVES[">"] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) > 0; + return a > b; + }; + PRIMITIVES["<="] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) <= 0; + return a <= b; + }; + PRIMITIVES[">="] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) >= 0; + return a >= b; + }; ''', "core.logic": ''' @@ -1023,14 +1102,14 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { "core.predicates": ''' // core.predicates PRIMITIVES["nil?"] = isNil; - PRIMITIVES["number?"] = function(x) { return typeof x === "number"; }; + PRIMITIVES["number?"] = function(x) { return typeof x === "number" || (x != null && x._rational === true); }; PRIMITIVES["integer?"] = function(x) { return typeof x === "number" && Number.isInteger(x); }; PRIMITIVES["float?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); }; - PRIMITIVES["exact?"] = function(x) { return typeof x === "number" && Number.isInteger(x); }; + PRIMITIVES["exact?"] = function(x) { return (typeof x === "number" && Number.isInteger(x)) || (x != null && x._rational === true); }; PRIMITIVES["inexact?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); }; PRIMITIVES["string?"] = function(x) { return typeof x === "string"; }; PRIMITIVES["list?"] = Array.isArray; - PRIMITIVES["dict?"] = function(x) { return x !== null && typeof x === "object" && !Array.isArray(x) && !x._sym && !x._kw && !x._string_buffer && !x._vector && !x._hash_table; }; + PRIMITIVES["dict?"] = function(x) { return x !== null && typeof x === "object" && !Array.isArray(x) && !x._sym && !x._kw && !x._string_buffer && !x._vector && !x._hash_table && !x._rational; }; PRIMITIVES["empty?"] = function(c) { return isNil(c) || (Array.isArray(c) ? c.length === 0 : typeof c === "string" ? c.length === 0 : Object.keys(c).length === 0); }; PRIMITIVES["contains?"] = function(c, k) { if (typeof c === "string") return c.indexOf(String(k)) !== -1; @@ -1450,6 +1529,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { return g === 0 ? 0 : Math.abs(a / g * b); }; PRIMITIVES["number->string"] = function(n, r) { + if (n && n._rational) return n._n + "/" + n._d; if (r === undefined || r === null) return String(n); return Math.floor(n).toString(r); }; @@ -1470,6 +1550,27 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { var n = Number(s); return isNaN(n) ? NIL : n; }; +''', + "stdlib.rational": ''' + // stdlib.rational + function SxRational(n, d) { + function gcd(a, b) { while (b) { var t=b; b=a%b; a=t; } return a; } + if (d === 0) throw new Error("make-rational: denominator cannot be zero"); + var sign = (d < 0) ? -1 : 1; + var g = gcd(Math.abs(n), Math.abs(d)); + this._n = sign * n / g; + this._d = sign * d / g; + this._rational = true; + } + SxRational.prototype.toString = function() { return this._n + "/" + this._d; }; + PRIMITIVES["make-rational"] = function(n, d) { + var r = new SxRational(Math.trunc(n), Math.trunc(d)); + if (r._d === 1) return r._n; + return r; + }; + PRIMITIVES["rational?"] = function(v) { return v instanceof SxRational; }; + PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; }; + PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; }; ''', "stdlib.hash-table": ''' // stdlib.hash-table @@ -1544,6 +1645,7 @@ PLATFORM_JS_PRE = ''' if (x._vector) return "vector"; if (x._string_buffer) return "string-buffer"; if (x._hash_table) return "hash-table"; + if (x._rational) return "rational"; if (typeof Node !== "undefined" && x instanceof Node) return "dom-node"; if (Array.isArray(x)) return "list"; if (typeof x === "object") return "dict"; diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 91c2d9a7..e1fb4314 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -1394,6 +1394,7 @@ let rec dispatch env cmd = | Char n -> Sx_types.inspect (Char n) | Eof -> Sx_types.inspect Eof | Port _ -> Sx_types.inspect result + | Rational (n, d) -> Printf.sprintf "%d/%d" n d | _ -> "nil" in send_ok_raw (raw_serialize result) diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index a19c2f1d..db727a1c 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -61,6 +61,7 @@ let all_ints = List.for_all (function Integer _ -> true | _ -> false) let rec as_number = function | Integer n -> float_of_int n | Number n -> n + | Rational(n, d) -> float_of_int n /. float_of_int d | Bool true -> 1.0 | Bool false -> 0.0 | Nil -> 0.0 @@ -101,32 +102,86 @@ let rec to_string = function let gensym_counter = ref 0 +let rat_gcd a b = + let rec g a b = if b = 0 then a else g b (a mod b) in g (abs a) (abs b) + +let make_rat n d = + if d = 0 then raise (Eval_error "rational: division by zero"); + let sign = if d < 0 then -1 else 1 in + let g = rat_gcd (abs n) (abs d) in + let rn = sign * n / g and rd = sign * d / g in + if rd = 1 then Integer rn else Rational (rn, rd) + +let rat_of_val = function + | Integer n -> (n, 1) + | Rational(n,d) -> (n, d) + | v -> raise (Eval_error ("expected integer or rational, got " ^ type_of v)) + +let has_rational args = List.exists (function Rational _ -> true | _ -> false) args +let has_float args = List.exists (function Number _ -> true | _ -> false) args + +let rat_add (an, ad) (bn, bd) = make_rat (an * bd + bn * ad) (ad * bd) +let rat_sub (an, ad) (bn, bd) = make_rat (an * bd - bn * ad) (ad * bd) +let rat_mul (an, ad) (bn, bd) = make_rat (an * bn) (ad * bd) +let rat_div (an, ad) (bn, bd) = + if bn = 0 then raise (Eval_error "rational: division by zero"); + make_rat (an * bd) (ad * bn) + let () = (* === Arithmetic === *) register "+" (fun args -> if all_ints args then Integer (List.fold_left (fun acc a -> match a with Integer n -> acc + n | _ -> acc) 0 args) + else if has_rational args && not (has_float args) then + List.fold_left (fun acc a -> + match acc, a with + | Integer an, _ -> rat_add (an, 1) (rat_of_val a) + | Rational(an,ad), _ -> rat_add (an, ad) (rat_of_val a) + | _ -> acc + ) (Integer 0) args else Number (List.fold_left (fun acc a -> acc +. as_number a) 0.0 args)); register "-" (fun args -> match args with | [] -> Integer 0 | [Integer n] -> Integer (-n) + | [Rational(n,d)] -> make_rat (-n) d | [a] -> Number (-. (as_number a)) | _ 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) + | _ when has_rational args && not (has_float args) -> + (match args with + | h :: tl -> + List.fold_left (fun acc a -> + match acc with + | Integer an -> rat_sub (an, 1) (rat_of_val a) + | Rational(an,ad) -> rat_sub (an, ad) (rat_of_val a) + | _ -> acc + ) h tl + | _ -> Integer 0) | a :: rest -> Number (List.fold_left (fun acc x -> acc -. as_number x) (as_number a) rest)); register "*" (fun args -> if all_ints args then Integer (List.fold_left (fun acc a -> match a with Integer n -> acc * n | _ -> acc) 1 args) + else if has_rational args && not (has_float args) then + List.fold_left (fun acc a -> + match acc with + | Integer an -> rat_mul (an, 1) (rat_of_val a) + | Rational(an,ad) -> rat_mul (an, ad) (rat_of_val a) + | _ -> acc + ) (Integer 1) args else Number (List.fold_left (fun acc a -> acc *. as_number a) 1.0 args)); register "/" (fun args -> match args with + | [Integer a; Integer b] -> make_rat a b + | [Rational(an,ad); Integer b] -> make_rat an (ad * b) + | [Integer a; Rational(bn,bd)] -> make_rat (a * bd) bn + | [Rational(an,ad); Rational(bn,bd)] -> rat_div (an, ad) (bn, bd) | [a; b] -> Number (as_number a /. as_number b) | _ -> raise (Eval_error "/: expected 2 args")); register "mod" (fun args -> @@ -315,6 +370,7 @@ let () = match args with | [Integer n] -> Number (float_of_int n) | [Number n] -> Number n + | [Rational(n,d)] -> Number (float_of_int n /. float_of_int d) | [a] -> Number (as_number a) | _ -> raise (Eval_error "exact->inexact: 1 arg")); register "inexact->exact" (fun args -> @@ -371,6 +427,7 @@ let () = match args with | [Integer n] -> String (string_of_int n) | [Number f] -> String (Printf.sprintf "%g" f) + | [Rational(n,d)] -> String (Printf.sprintf "%d/%d" n d) | [Integer n; Integer r] -> if r < 2 || r > 36 then raise (Eval_error "number->string: radix out of range"); String (int_to_radix n r) @@ -402,6 +459,35 @@ let () = Integer (if neg then - !n else !n) with _ -> Nil) | _ -> raise (Eval_error "string->number: 1-2 args")); + let make_rational_val n d = + if d = 0 then raise (Eval_error "make-rational: denominator cannot be zero"); + let rec gcd a b = if b = 0 then a else gcd b (a mod b) in + let sign = if d < 0 then -1 else 1 in + let g = gcd (abs n) (abs d) in + let rn = sign * n / g and rd = sign * d / g in + if rd = 1 then Integer rn else Rational (rn, rd) + in + register "make-rational" (fun args -> + match args with + | [Integer n; Integer d] -> make_rational_val n d + | [Number f; Integer d] -> make_rational_val (int_of_float f) d + | [Integer n; Number f] -> make_rational_val n (int_of_float f) + | _ -> raise (Eval_error "make-rational: expected 2 integers")); + register "rational?" (fun args -> + match args with + | [Rational _] -> Bool true + | [_] -> Bool false + | _ -> raise (Eval_error "rational?: expected 1 arg")); + register "numerator" (fun args -> + match args with + | [Rational (n, _)] -> Integer n + | [Integer n] -> Integer n + | _ -> raise (Eval_error "numerator: expected rational or integer")); + register "denominator" (fun args -> + match args with + | [Rational (_, d)] -> Integer d + | [Integer _] -> Integer 1 + | _ -> raise (Eval_error "denominator: expected rational or integer")); register "parse-int" (fun args -> let parse_leading_int s = let len = String.length s in @@ -442,6 +528,11 @@ let () = | Number x, Number y -> x = y | Integer x, Number y -> float_of_int x = y | Number x, Integer y -> x = float_of_int y + | Rational(n, d), Number y -> float_of_int n /. float_of_int d = y + | Number x, Rational(n, d) -> x = float_of_int n /. float_of_int d + | Rational(an, ad), Rational(bn, bd) -> an * bd = bn * ad + | Rational(n, d), Integer y -> n = y * d + | Integer x, Rational(n, d) -> x * d = n | String x, String y -> x = y | Bool x, Bool y -> x = y | Nil, Nil -> true diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index 81f94b3f..df3c1070 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -78,6 +78,7 @@ and value = | Char of int (** Unicode codepoint — R7RS char type. *) | Eof (** EOF sentinel — returned by read-char etc. at end of input. *) | Port of sx_port (** String port — input (string cursor) or output (buffer). *) + | Rational of int * int (** Exact rational: numerator, denominator (reduced, denom>0). *) (** String input port: source string + mutable cursor position. *) and sx_port_kind = @@ -512,6 +513,7 @@ let type_of = function | Eof -> "eof-object" | Port { sp_kind = PortInput _; _ } -> "input-port" | Port { sp_kind = PortOutput _; _ } -> "output-port" + | Rational _ -> "rational" let is_nil = function Nil -> true | _ -> false let is_lambda = function Lambda _ -> true | _ -> false @@ -873,3 +875,4 @@ let rec inspect = function Printf.sprintf "" !pos (if sp_closed then ":closed" else "") | Port { sp_kind = PortOutput buf; sp_closed } -> Printf.sprintf "" (Buffer.length buf) (if sp_closed then ":closed" else "") + | Rational (n, d) -> Printf.sprintf "%d/%d" n d diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 028387ea..17736e6f 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -23,6 +23,9 @@ } return true; } + if (a && b && a._rational && b._rational) return a._n === b._n && a._d === b._d; + if (a && a._rational && typeof b === "number") return b === a._n / a._d; + if (b && b._rational && typeof a === "number") return a === b._n / b._d; return false; } @@ -31,7 +34,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-05-01T13:12:47Z"; + var SX_VERSION = "2026-05-01T17:11:41Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -174,6 +177,7 @@ if (x._vector) return "vector"; if (x._string_buffer) return "string-buffer"; if (x._hash_table) return "hash-table"; + if (x._rational) return "rational"; if (typeof Node !== "undefined" && x instanceof Node) return "dom-node"; if (Array.isArray(x)) return "list"; if (typeof x === "object") return "dict"; @@ -379,10 +383,68 @@ var PRIMITIVES = {}; // core.arithmetic - PRIMITIVES["+"] = function() { var s = 0; for (var i = 0; i < arguments.length; i++) s += arguments[i]; return s; }; - PRIMITIVES["-"] = function(a, b) { return arguments.length === 1 ? -a : a - b; }; - PRIMITIVES["*"] = function() { var s = 1; for (var i = 0; i < arguments.length; i++) s *= arguments[i]; return s; }; - PRIMITIVES["/"] = function(a, b) { return a / b; }; + function _ratMake(n, d) { + if (d === 0) throw new Error("division by zero"); + var r = new SxRational(n, d); + return r._d === 1 ? r._n : r; + } + function _ratN(x) { return x && x._rational ? x._n : x; } + function _ratD(x) { return x && x._rational ? x._d : 1; } + function _hasFloat(args) { + for (var i = 0; i < args.length; i++) { + var x = args[i]; + if (typeof x === "number" && !Number.isInteger(x)) return true; + } + return false; + } + function _ratToFloat(x) { return x && x._rational ? x._n / x._d : x; } + PRIMITIVES["+"] = function() { + var hasRat = false; + for (var i = 0; i < arguments.length; i++) if (arguments[i] && arguments[i]._rational) { hasRat = true; break; } + if (!hasRat) { var s = 0; for (var i = 0; i < arguments.length; i++) s += arguments[i]; return s; } + if (_hasFloat(arguments)) { var s = 0; for (var i = 0; i < arguments.length; i++) s += _ratToFloat(arguments[i]); return s; } + var an = 0, ad = 1; + for (var i = 0; i < arguments.length; i++) { + var bn = _ratN(arguments[i]), bd = _ratD(arguments[i]); + an = an * bd + bn * ad; ad = ad * bd; + } + return _ratMake(an, ad); + }; + PRIMITIVES["-"] = function() { + if (arguments.length === 0) return 0; + var hasRat = false; + for (var i = 0; i < arguments.length; i++) if (arguments[i] && arguments[i]._rational) { hasRat = true; break; } + if (!hasRat) return arguments.length === 1 ? -arguments[0] : arguments[0] - arguments[1]; + if (_hasFloat(arguments)) { + if (arguments.length === 1) return -_ratToFloat(arguments[0]); + var s = _ratToFloat(arguments[0]); + for (var i = 1; i < arguments.length; i++) s -= _ratToFloat(arguments[i]); + return s; + } + if (arguments.length === 1) { var x = arguments[0]; return x._rational ? _ratMake(-x._n, x._d) : -x; } + var an = _ratN(arguments[0]), ad = _ratD(arguments[0]); + for (var i = 1; i < arguments.length; i++) { + var bn = _ratN(arguments[i]), bd = _ratD(arguments[i]); + an = an * bd - bn * ad; ad = ad * bd; + } + return _ratMake(an, ad); + }; + PRIMITIVES["*"] = function() { + var hasRat = false; + for (var i = 0; i < arguments.length; i++) if (arguments[i] && arguments[i]._rational) { hasRat = true; break; } + if (!hasRat) { var s = 1; for (var i = 0; i < arguments.length; i++) s *= arguments[i]; return s; } + if (_hasFloat(arguments)) { var s = 1; for (var i = 0; i < arguments.length; i++) s *= _ratToFloat(arguments[i]); return s; } + var an = 1, ad = 1; + for (var i = 0; i < arguments.length; i++) { an *= _ratN(arguments[i]); ad *= _ratD(arguments[i]); } + return _ratMake(an, ad); + }; + PRIMITIVES["/"] = function(a, b) { + var aRat = a && a._rational, bRat = b && b._rational; + if (!aRat && !bRat) return a / b; + if (typeof a === "number" && !Number.isInteger(a) || typeof b === "number" && !Number.isInteger(b)) + return _ratToFloat(a) / _ratToFloat(b); + return _ratMake(_ratN(a) * _ratD(b), _ratD(a) * _ratN(b)); + }; PRIMITIVES["mod"] = function(a, b) { return a % b; }; PRIMITIVES["inc"] = function(n) { return n + 1; }; PRIMITIVES["dec"] = function(n) { return n - 1; }; @@ -402,18 +464,36 @@ PRIMITIVES["pow"] = Math.pow; PRIMITIVES["clamp"] = function(x, lo, hi) { return Math.max(lo, Math.min(hi, x)); }; PRIMITIVES["random-int"] = function(lo, hi) { return Math.floor(Math.random() * (hi - lo + 1)) + lo; }; - PRIMITIVES["exact->inexact"] = function(x) { return x; }; + PRIMITIVES["exact->inexact"] = function(x) { + if (x && x._rational) return x._n / x._d; + return x; + }; PRIMITIVES["inexact->exact"] = Math.round; PRIMITIVES["parse-number"] = function(s) { var n = Number(s); return isNaN(n) ? null : n; }; // core.comparison + function _ratCmp(a, b) { + return _ratN(a) * _ratD(b) - _ratN(b) * _ratD(a); + } PRIMITIVES["="] = sxEq; PRIMITIVES["!="] = function(a, b) { return !sxEq(a, b); }; - PRIMITIVES["<"] = function(a, b) { return a < b; }; - PRIMITIVES[">"] = function(a, b) { return a > b; }; - PRIMITIVES["<="] = function(a, b) { return a <= b; }; - PRIMITIVES[">="] = function(a, b) { return a >= b; }; + PRIMITIVES["<"] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) < 0; + return a < b; + }; + PRIMITIVES[">"] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) > 0; + return a > b; + }; + PRIMITIVES["<="] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) <= 0; + return a <= b; + }; + PRIMITIVES[">="] = function(a, b) { + if ((a && a._rational) || (b && b._rational)) return _ratCmp(a, b) >= 0; + return a >= b; + }; // core.logic @@ -422,14 +502,14 @@ // core.predicates PRIMITIVES["nil?"] = isNil; - PRIMITIVES["number?"] = function(x) { return typeof x === "number"; }; + PRIMITIVES["number?"] = function(x) { return typeof x === "number" || (x != null && x._rational === true); }; PRIMITIVES["integer?"] = function(x) { return typeof x === "number" && Number.isInteger(x); }; PRIMITIVES["float?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); }; - PRIMITIVES["exact?"] = function(x) { return typeof x === "number" && Number.isInteger(x); }; + PRIMITIVES["exact?"] = function(x) { return (typeof x === "number" && Number.isInteger(x)) || (x != null && x._rational === true); }; PRIMITIVES["inexact?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); }; PRIMITIVES["string?"] = function(x) { return typeof x === "string"; }; PRIMITIVES["list?"] = Array.isArray; - PRIMITIVES["dict?"] = function(x) { return x !== null && typeof x === "object" && !Array.isArray(x) && !x._sym && !x._kw && !x._string_buffer && !x._vector && !x._hash_table; }; + PRIMITIVES["dict?"] = function(x) { return x !== null && typeof x === "object" && !Array.isArray(x) && !x._sym && !x._kw && !x._string_buffer && !x._vector && !x._hash_table && !x._rational; }; PRIMITIVES["empty?"] = function(c) { return isNil(c) || (Array.isArray(c) ? c.length === 0 : typeof c === "string" ? c.length === 0 : Object.keys(c).length === 0); }; PRIMITIVES["contains?"] = function(c, k) { if (typeof c === "string") return c.indexOf(String(k)) !== -1; @@ -841,6 +921,7 @@ return g === 0 ? 0 : Math.abs(a / g * b); }; PRIMITIVES["number->string"] = function(n, r) { + if (n && n._rational) return n._n + "/" + n._d; if (r === undefined || r === null) return String(n); return Math.floor(n).toString(r); }; @@ -863,6 +944,27 @@ }; + // stdlib.rational + function SxRational(n, d) { + function gcd(a, b) { while (b) { var t=b; b=a%b; a=t; } return a; } + if (d === 0) throw new Error("make-rational: denominator cannot be zero"); + var sign = (d < 0) ? -1 : 1; + var g = gcd(Math.abs(n), Math.abs(d)); + this._n = sign * n / g; + this._d = sign * d / g; + this._rational = true; + } + SxRational.prototype.toString = function() { return this._n + "/" + this._d; }; + PRIMITIVES["make-rational"] = function(n, d) { + var r = new SxRational(Math.trunc(n), Math.trunc(d)); + if (r._d === 1) return r._n; + return r; + }; + PRIMITIVES["rational?"] = function(v) { return v instanceof SxRational; }; + PRIMITIVES["numerator"] = function(r) { return r instanceof SxRational ? r._n : r; }; + PRIMITIVES["denominator"] = function(r) { return r instanceof SxRational ? r._d : 1; }; + + // stdlib.hash-table function SxHashTable() { this.data = new Map(); this._hash_table = true; } PRIMITIVES["make-hash-table"] = function() { return new SxHashTable(); }; @@ -3997,18 +4099,18 @@ PRIMITIVES["read-keyword"] = readKeyword; continue; } else { return NIL; } } }; PRIMITIVES["read-digits"] = readDigits; readDigits(); - if (isSxTruthy((isSxTruthy((pos < lenSrc)) && sxEq(nth(source, pos), ".")))) { + return (isSxTruthy((isSxTruthy((pos < lenSrc)) && isSxTruthy(sxEq(nth(source, pos), "/")) && isSxTruthy(((pos + 1) < lenSrc)) && (function() { + var nc = nth(source, (pos + 1)); + return (isSxTruthy((nc >= "0")) && (nc <= "9")); +})())) ? (function() { + var numer = parseNumber(slice(source, start, pos)); pos = (pos + 1); + return (function() { + var denomStart = pos; readDigits(); -} - if (isSxTruthy((isSxTruthy((pos < lenSrc)) && sxOr(sxEq(nth(source, pos), "e"), sxEq(nth(source, pos), "E"))))) { - pos = (pos + 1); - if (isSxTruthy((isSxTruthy((pos < lenSrc)) && sxOr(sxEq(nth(source, pos), "+"), sxEq(nth(source, pos), "-"))))) { - pos = (pos + 1); -} - readDigits(); -} - return parseNumber(slice(source, start, pos)); + return makeRational(numer, parseNumber(slice(source, denomStart, pos))); +})(); +})() : ((isSxTruthy((isSxTruthy((pos < lenSrc)) && sxEq(nth(source, pos), "."))) ? ((pos = (pos + 1)), readDigits()) : NIL), (isSxTruthy((isSxTruthy((pos < lenSrc)) && sxOr(sxEq(nth(source, pos), "e"), sxEq(nth(source, pos), "E")))) ? ((pos = (pos + 1)), (isSxTruthy((isSxTruthy((pos < lenSrc)) && sxOr(sxEq(nth(source, pos), "+"), sxEq(nth(source, pos), "-")))) ? (pos = (pos + 1)) : NIL), readDigits()) : NIL), parseNumber(slice(source, start, pos)))); })(); }; PRIMITIVES["read-number"] = readNumber; var readSymbol = function() { return (function() { @@ -4105,7 +4207,7 @@ PRIMITIVES["parse-loop"] = parseLoop; PRIMITIVES["sx-parse"] = sxParse; // sx-serialize - var sxSerialize = function(val) { return (function() { var _m = typeOf(val); if (_m == "nil") return "nil"; if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "number") return (String(val)); if (_m == "string") return (String("\"") + String(escapeString(val)) + String("\"")); if (_m == "symbol") return symbolName(val); if (_m == "keyword") return (String(":") + String(keywordName(val))); if (_m == "list") return (String("(") + String(join(" ", map(sxSerialize, val))) + String(")")); if (_m == "dict") return sxSerializeDict(val); if (_m == "sx-expr") return sxExprSource(val); if (_m == "spread") return (String("(make-spread ") + String(sxSerializeDict(spreadAttrs(val))) + String(")")); if (_m == "char") return (function() { + var sxSerialize = function(val) { return (function() { var _m = typeOf(val); if (_m == "nil") return "nil"; if (_m == "boolean") return (isSxTruthy(val) ? "true" : "false"); if (_m == "number") return (String(val)); if (_m == "rational") return (String(numerator(val)) + String("/") + String(denominator(val))); if (_m == "string") return (String("\"") + String(escapeString(val)) + String("\"")); if (_m == "symbol") return symbolName(val); if (_m == "keyword") return (String(":") + String(keywordName(val))); if (_m == "list") return (String("(") + String(join(" ", map(sxSerialize, val))) + String(")")); if (_m == "dict") return sxSerializeDict(val); if (_m == "sx-expr") return sxExprSource(val); if (_m == "spread") return (String("(make-spread ") + String(sxSerializeDict(spreadAttrs(val))) + String(")")); if (_m == "char") return (function() { var n = charToInteger(val); return (String("#\\") + String((isSxTruthy(sxEq(n, 32)) ? "space" : (isSxTruthy(sxEq(n, 10)) ? "newline" : (isSxTruthy(sxEq(n, 9)) ? "tab" : (isSxTruthy(sxEq(n, 13)) ? "return" : (isSxTruthy(sxEq(n, 0)) ? "nul" : (isSxTruthy(sxEq(n, 27)) ? "escape" : (isSxTruthy(sxEq(n, 127)) ? "delete" : (isSxTruthy(sxEq(n, 8)) ? "backspace" : charFromCode(n))))))))))); })(); return (String(val)); })(); }; diff --git a/spec/parser.sx b/spec/parser.sx index 8f2a7f85..c287989e 100644 --- a/spec/parser.sx +++ b/spec/parser.sx @@ -14,9 +14,10 @@ ;; list → '(' expr* ')' ;; vector → '[' expr* ']' (sugar for list) ;; map → '{' (key expr)* '}' -;; atom → string | number | keyword | symbol | boolean | nil | char +;; atom → string | number | rational | keyword | symbol | boolean | nil | char ;; string → '"' (char | escape)* '"' ;; number → '-'? digit+ ('.' digit+)? ([eE] [+-]? digit+)? +;; rational → integer '/' digit+ ;; keyword → ':' ident ;; symbol → ident ;; boolean → 'true' | 'false' @@ -46,6 +47,7 @@ ;; (make-keyword name) → Keyword value ;; (escape-string s) → string with " and \ escaped for serialization ;; (make-char n) → Char value from Unicode codepoint +;; (make-rational n d) → Rational value (auto-reduced by GCD) ;; (char->integer c) → Unicode codepoint of char c ;; (char-from-code n) → single-char string from codepoint ;; (char-code s) → codepoint of first char in string s @@ -210,22 +212,42 @@ (set! pos (inc pos)) (read-digits)))) (read-digits) - (when - (and (< pos len-src) (= (nth source pos) ".")) - (set! pos (inc pos)) - (read-digits)) - (when + (if (and (< pos len-src) - (or (= (nth source pos) "e") (= (nth source pos) "E"))) - (set! pos (inc pos)) - (when - (and - (< pos len-src) - (or (= (nth source pos) "+") (= (nth source pos) "-"))) - (set! pos (inc pos))) - (read-digits)) - (parse-number (slice source start pos))))) + (= (nth source pos) "/") + (< (inc pos) len-src) + (let + ((nc (nth source (inc pos)))) + (and (>= nc "0") (<= nc "9")))) + (let + ((numer (parse-number (slice source start pos)))) + (set! pos (inc pos)) + (let + ((denom-start pos)) + (read-digits) + (make-rational + numer + (parse-number (slice source denom-start pos))))) + (do + (when + (and (< pos len-src) (= (nth source pos) ".")) + (set! pos (inc pos)) + (read-digits)) + (when + (and + (< pos len-src) + (or (= (nth source pos) "e") (= (nth source pos) "E"))) + (set! pos (inc pos)) + (when + (and + (< pos len-src) + (or + (= (nth source pos) "+") + (= (nth source pos) "-"))) + (set! pos (inc pos))) + (read-digits)) + (parse-number (slice source start pos))))))) (define read-symbol :effects () @@ -490,6 +512,8 @@ (if val "true" "false") "number" (str val) + "rational" + (str (numerator val) "/" (denominator val)) "string" (str "\"" (escape-string val) "\"") "symbol" @@ -567,11 +591,12 @@ ;; True for: ident-start chars plus: 0-9 . : / # , ;; ;; Constructors (provided by the SX runtime): -;; (make-symbol name) → Symbol value -;; (make-keyword name) → Keyword value -;; (parse-number s) → number (int or float from string) -;; (make-char n) → Char value from Unicode codepoint n -;; (char->integer c) → Unicode codepoint of char c +;; (make-symbol name) → Symbol value +;; (make-keyword name) → Keyword value +;; (parse-number s) → number (int or float from string) +;; (make-char n) → Char value from Unicode codepoint n +;; (make-rational n d) → Rational value (auto-reduced by GCD; d=0 is an error) +;; (char->integer c) → Unicode codepoint of char c ;; ;; String utilities: ;; (escape-string s) → string with " and \ escaped diff --git a/spec/primitives.sx b/spec/primitives.sx index 79e6fcfd..5ca6c195 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -1034,4 +1034,30 @@ :returns "any" :doc "Parse string s as a number. Optional radix (default 10). Returns nil on failure.") +(define-module :stdlib.rational) + +(define-primitive + "make-rational" + :params (n d) + :returns "rational" + :doc "Rational n/d, auto-reduced by GCD. Error if d=0.") + +(define-primitive + "rational?" + :params (v) + :returns "boolean" + :doc "True if v is a rational number.") + +(define-primitive + "numerator" + :params ((r :as rational)) + :returns "integer" + :doc "Numerator of rational r (after reduction).") + +(define-primitive + "denominator" + :params ((r :as rational)) + :returns "integer" + :doc "Denominator of rational r (after reduction, always positive).") + (define-module :stdlib.hash-table) diff --git a/spec/tests/test-eval.sx b/spec/tests/test-eval.sx index d9ebfd0e..f62e4db8 100644 --- a/spec/tests/test-eval.sx +++ b/spec/tests/test-eval.sx @@ -10,57 +10,56 @@ ;; Literals and types ;; -------------------------------------------------------------------------- -(defsuite "literals" - (deftest "numbers are numbers" +(defsuite + "literals" + (deftest + "numbers are numbers" (assert-type "number" 42) (assert-type "number" 3.14) (assert-type "number" -1)) - - (deftest "strings are strings" + (deftest + "strings are strings" (assert-type "string" "hello") (assert-type "string" "")) - - (deftest "booleans are booleans" + (deftest + "booleans are booleans" (assert-type "boolean" true) (assert-type "boolean" false)) - - (deftest "nil is nil" - (assert-type "nil" nil) - (assert-nil nil)) - - (deftest "lists are lists" + (deftest "nil is nil" (assert-type "nil" nil) (assert-nil nil)) + (deftest + "lists are lists" (assert-type "list" (list 1 2 3)) (assert-type "list" (list))) - - (deftest "dicts are dicts" - (assert-type "dict" {:a 1 :b 2}))) + (deftest "dicts are dicts" (assert-type "dict" {:b 2 :a 1}))) ;; -------------------------------------------------------------------------- ;; Arithmetic ;; -------------------------------------------------------------------------- -(defsuite "arithmetic" - (deftest "addition" +(defsuite + "arithmetic" + (deftest + "addition" (assert-equal 3 (+ 1 2)) (assert-equal 0 (+ 0 0)) (assert-equal -1 (+ 1 -2)) (assert-equal 10 (+ 1 2 3 4))) - - (deftest "subtraction" + (deftest + "subtraction" (assert-equal 1 (- 3 2)) (assert-equal -1 (- 2 3))) - - (deftest "multiplication" + (deftest + "multiplication" (assert-equal 6 (* 2 3)) (assert-equal 0 (* 0 100)) (assert-equal 24 (* 1 2 3 4))) - - (deftest "division" + (deftest + "division" (assert-equal 2 (/ 6 3)) (assert-equal 2.5 (/ 5 2))) - - (deftest "modulo" + (deftest + "modulo" (assert-equal 1 (mod 7 3)) (assert-equal 0 (mod 6 3)))) @@ -69,20 +68,26 @@ ;; Comparison ;; -------------------------------------------------------------------------- -(defsuite "comparison" - (deftest "equality" +(defsuite + "comparison" + (deftest + "equality" (assert-true (= 1 1)) (assert-false (= 1 2)) (assert-true (= "a" "a")) (assert-false (= "a" "b"))) - - (deftest "deep equality" - (assert-true (equal? (list 1 2 3) (list 1 2 3))) - (assert-false (equal? (list 1 2) (list 1 3))) + (deftest + "deep equality" + (assert-true + (equal? + (list 1 2 3) + (list 1 2 3))) + (assert-false + (equal? (list 1 2) (list 1 3))) (assert-true (equal? {:a 1} {:a 1})) (assert-false (equal? {:a 1} {:a 2}))) - - (deftest "ordering" + (deftest + "ordering" (assert-true (< 1 2)) (assert-false (< 2 1)) (assert-true (> 2 1)) @@ -96,34 +101,36 @@ ;; String operations ;; -------------------------------------------------------------------------- -(defsuite "strings" - (deftest "str concatenation" +(defsuite + "strings" + (deftest + "str concatenation" (assert-equal "abc" (str "a" "b" "c")) (assert-equal "hello world" (str "hello" " " "world")) (assert-equal "42" (str 42)) (assert-equal "" (str))) - - (deftest "string-length" + (deftest + "string-length" (assert-equal 5 (string-length "hello")) (assert-equal 0 (string-length ""))) - - (deftest "substring" + (deftest + "substring" (assert-equal "ell" (substring "hello" 1 4)) (assert-equal "hello" (substring "hello" 0 5))) - - (deftest "string-contains?" + (deftest + "string-contains?" (assert-true (string-contains? "hello world" "world")) (assert-false (string-contains? "hello" "xyz"))) - - (deftest "upcase and downcase" + (deftest + "upcase and downcase" (assert-equal "HELLO" (upcase "hello")) (assert-equal "hello" (downcase "HELLO"))) - - (deftest "trim" + (deftest + "trim" (assert-equal "hello" (trim " hello ")) (assert-equal "hello" (trim "hello"))) - - (deftest "split and join" + (deftest + "split and join" (assert-equal (list "a" "b" "c") (split "a,b,c" ",")) (assert-equal "a-b-c" (join "-" (list "a" "b" "c"))))) @@ -132,121 +139,145 @@ ;; List operations ;; -------------------------------------------------------------------------- -(defsuite "lists" - (deftest "constructors" - (assert-equal (list 1 2 3) (list 1 2 3)) +(defsuite + "lists" + (deftest + "constructors" + (assert-equal + (list 1 2 3) + (list 1 2 3)) (assert-equal (list) (list)) (assert-length 3 (list 1 2 3))) - - (deftest "first and rest" + (deftest + "first and rest" (assert-equal 1 (first (list 1 2 3))) - (assert-equal (list 2 3) (rest (list 1 2 3))) + (assert-equal + (list 2 3) + (rest (list 1 2 3))) (assert-nil (first (list))) (assert-equal (list) (rest (list)))) - - (deftest "nth" - (assert-equal 1 (nth (list 1 2 3) 0)) - (assert-equal 2 (nth (list 1 2 3) 1)) - (assert-equal 3 (nth (list 1 2 3) 2))) - - (deftest "last" + (deftest + "nth" + (assert-equal + 1 + (nth (list 1 2 3) 0)) + (assert-equal + 2 + (nth (list 1 2 3) 1)) + (assert-equal + 3 + (nth (list 1 2 3) 2))) + (deftest + "last" (assert-equal 3 (last (list 1 2 3))) (assert-nil (last (list)))) - - (deftest "cons and append" - (assert-equal (list 0 1 2) (cons 0 (list 1 2))) - (assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4)))) - - (deftest "reverse" - (assert-equal (list 3 2 1) (reverse (list 1 2 3))) + (deftest + "cons and append" + (assert-equal + (list 0 1 2) + (cons 0 (list 1 2))) + (assert-equal + (list 1 2 3 4) + (append (list 1 2) (list 3 4)))) + (deftest + "reverse" + (assert-equal + (list 3 2 1) + (reverse (list 1 2 3))) (assert-equal (list) (reverse (list)))) - - (deftest "empty?" + (deftest + "empty?" (assert-true (empty? (list))) (assert-false (empty? (list 1)))) - - (deftest "len" + (deftest + "len" (assert-equal 0 (len (list))) (assert-equal 3 (len (list 1 2 3)))) - - (deftest "contains?" - (assert-true (contains? (list 1 2 3) 2)) - (assert-false (contains? (list 1 2 3) 4))) - - (deftest "flatten" - (assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4)))))) + (deftest + "contains?" + (assert-true + (contains? (list 1 2 3) 2)) + (assert-false + (contains? (list 1 2 3) 4))) + (deftest + "flatten" + (assert-equal + (list 1 2 3 4) + (flatten + (list (list 1 2) (list 3 4)))))) ;; -------------------------------------------------------------------------- ;; Dict operations ;; -------------------------------------------------------------------------- -(defsuite "dicts" - (deftest "dict literal" - (assert-type "dict" {:a 1 :b 2}) +(defsuite + "dicts" + (deftest + "dict literal" + (assert-type "dict" {:b 2 :a 1}) (assert-equal 1 (get {:a 1} "a")) - (assert-equal 2 (get {:a 1 :b 2} "b"))) - - (deftest "assoc" - (assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2)) + (assert-equal 2 (get {:b 2 :a 1} "b"))) + (deftest + "assoc" + (assert-equal {:b 2 :a 1} (assoc {:a 1} "b" 2)) (assert-equal {:a 99} (assoc {:a 1} "a" 99))) - - (deftest "dissoc" - (assert-equal {:b 2} (dissoc {:a 1 :b 2} "a"))) - - (deftest "keys and vals" - (let ((d {:a 1 :b 2})) + (deftest "dissoc" (assert-equal {:b 2} (dissoc {:b 2 :a 1} "a"))) + (deftest + "keys and vals" + (let + ((d {:b 2 :a 1})) (assert-length 2 (keys d)) (assert-length 2 (vals d)) (assert-contains "a" (keys d)) (assert-contains "b" (keys d)))) - - (deftest "has-key?" + (deftest + "has-key?" (assert-true (has-key? {:a 1} "a")) (assert-false (has-key? {:a 1} "b"))) - - (deftest "merge" - (assert-equal {:a 1 :b 2 :c 3} - (merge {:a 1 :b 2} {:c 3})) - (assert-equal {:a 99 :b 2} - (merge {:a 1 :b 2} {:a 99})))) + (deftest + "merge" + (assert-equal {:c 3 :b 2 :a 1} (merge {:b 2 :a 1} {:c 3})) + (assert-equal {:b 2 :a 99} (merge {:b 2 :a 1} {:a 99})))) ;; -------------------------------------------------------------------------- ;; Predicates ;; -------------------------------------------------------------------------- -(defsuite "predicates" - (deftest "nil?" +(defsuite + "predicates" + (deftest + "nil?" (assert-true (nil? nil)) (assert-false (nil? 0)) (assert-false (nil? false)) (assert-false (nil? ""))) - - (deftest "number?" + (deftest + "number?" (assert-true (number? 42)) (assert-true (number? 3.14)) (assert-false (number? "42"))) - - (deftest "string?" + (deftest + "string?" (assert-true (string? "hello")) (assert-false (string? 42))) - - (deftest "list?" + (deftest + "list?" (assert-true (list? (list 1 2))) (assert-false (list? "not a list"))) - - (deftest "dict?" + (deftest + "dict?" (assert-true (dict? {:a 1})) (assert-false (dict? (list 1)))) - - (deftest "boolean?" + (deftest + "boolean?" (assert-true (boolean? true)) (assert-true (boolean? false)) (assert-false (boolean? nil)) (assert-false (boolean? 0))) - - (deftest "not" + (deftest + "not" (assert-true (not false)) (assert-true (not nil)) (assert-false (not true)) @@ -258,77 +289,67 @@ ;; Special forms ;; -------------------------------------------------------------------------- -(defsuite "special-forms" - (deftest "if" +(defsuite + "special-forms" + (deftest + "if" (assert-equal "yes" (if true "yes" "no")) (assert-equal "no" (if false "yes" "no")) (assert-equal "no" (if nil "yes" "no")) (assert-nil (if false "yes"))) - - (deftest "when" + (deftest + "when" (assert-equal "yes" (when true "yes")) (assert-nil (when false "yes"))) - - (deftest "cond" + (deftest + "cond" (assert-equal "a" (cond true "a" :else "b")) (assert-equal "b" (cond false "a" :else "b")) - (assert-equal "c" (cond - false "a" - false "b" - :else "c"))) - - (deftest "cond with 2-element predicate as first test" - ;; Regression: cond misclassifies Clojure-style as scheme-style when - ;; the first test is a 2-element list like (nil? x) or (empty? x). - ;; The evaluator checks: is first arg a 2-element list? If yes, treats - ;; as scheme-style ((test body) ...) — returning the arg instead of - ;; evaluating the predicate call. + (assert-equal "c" (cond false "a" false "b" :else "c"))) + (deftest + "cond with 2-element predicate as first test" (assert-equal 0 (cond (nil? nil) 0 :else 1)) (assert-equal 1 (cond (nil? "x") 0 :else 1)) (assert-equal "empty" (cond (empty? (list)) "empty" :else "not-empty")) - (assert-equal "not-empty" (cond (empty? (list 1)) "empty" :else "not-empty")) + (assert-equal + "not-empty" + (cond (empty? (list 1)) "empty" :else "not-empty")) (assert-equal "yes" (cond (not false) "yes" :else "no")) (assert-equal "no" (cond (not true) "yes" :else "no"))) - - (deftest "cond with 2-element predicate and no :else" - ;; Same bug, but without :else — this is the worst case because the - ;; bootstrapper heuristic also breaks (all clauses are 2-element lists). - (assert-equal "found" - (cond (nil? nil) "found" - (nil? "x") "other")) - (assert-equal "b" - (cond (nil? "x") "a" - (not false) "b"))) - - (deftest "and" + (deftest + "cond with 2-element predicate and no :else" + (assert-equal "found" (cond (nil? nil) "found" (nil? "x") "other")) + (assert-equal "b" (cond (nil? "x") "a" (not false) "b"))) + (deftest + "and" (assert-true (and true true)) (assert-false (and true false)) (assert-false (and false true)) (assert-equal 3 (and 1 2 3))) - - (deftest "or" + (deftest + "or" (assert-equal 1 (or 1 2)) (assert-equal 2 (or false 2)) (assert-equal "fallback" (or nil false "fallback")) (assert-false (or false false))) - - (deftest "let" - (assert-equal 3 (let ((x 1) (y 2)) (+ x y))) - (assert-equal "hello world" + (deftest + "let" + (assert-equal + 3 + (let ((x 1) (y 2)) (+ x y))) + (assert-equal + "hello world" (let ((a "hello") (b " world")) (str a b)))) - - (deftest "let clojure-style" + (deftest + "let clojure-style" (assert-equal 3 (let (x 1 y 2) (+ x y)))) - - (deftest "do / begin" + (deftest + "do / begin" (assert-equal 3 (do 1 2 3)) (assert-equal "last" (begin "first" "middle" "last"))) - - (deftest "define" - (define x 42) - (assert-equal 42 x)) - - (deftest "set!" + (deftest "define" (define x 42) (assert-equal 42 x)) + (deftest + "set!" (define x 1) (set! x 2) (assert-equal 2 x))) @@ -338,86 +359,126 @@ ;; Lambda and closures ;; -------------------------------------------------------------------------- -(defsuite "lambdas" - (deftest "basic lambda" - (let ((add (fn (a b) (+ a b)))) +(defsuite + "lambdas" + (deftest + "basic lambda" + (let + ((add (fn (a b) (+ a b)))) (assert-equal 3 (add 1 2)))) - - (deftest "closure captures env" - (let ((x 10)) - (let ((add-x (fn (y) (+ x y)))) + (deftest + "closure captures env" + (let + ((x 10)) + (let + ((add-x (fn (y) (+ x y)))) (assert-equal 15 (add-x 5))))) - - (deftest "lambda as argument" - (assert-equal (list 2 4 6) - (map (fn (x) (* x 2)) (list 1 2 3)))) - - (deftest "recursive lambda via define" - (define factorial - (fn (n) (if (<= n 1) 1 (* n (factorial (- n 1)))))) + (deftest + "lambda as argument" + (assert-equal + (list 2 4 6) + (map + (fn (x) (* x 2)) + (list 1 2 3)))) + (deftest + "recursive lambda via define" + (define + factorial + (fn + (n) + (if + (<= n 1) + 1 + (* n (factorial (- n 1)))))) (assert-equal 120 (factorial 5))) - - (deftest "higher-order returns lambda" - (let ((make-adder (fn (n) (fn (x) (+ n x))))) - (let ((add5 (make-adder 5))) + (deftest + "higher-order returns lambda" + (let + ((make-adder (fn (n) (fn (x) (+ n x))))) + (let + ((add5 (make-adder 5))) (assert-equal 8 (add5 3))))) - - (deftest "multi-body lambda returns last value" - ;; All body expressions must execute. Return value is the last. - ;; Catches: sf-lambda using nth(args,1) instead of rest(args). - (let ((f (fn (x) (+ x 1) (+ x 2) (+ x 3)))) + (deftest + "multi-body lambda returns last value" + (let + ((f (fn (x) (+ x 1) (+ x 2) (+ x 3)))) (assert-equal 13 (f 10)))) - - (deftest "multi-body lambda side effects via dict mutation" - ;; Verify all body expressions run by mutating a shared dict. - (let ((state (dict "a" 0 "b" 0))) - (let ((f (fn () - (dict-set! state "a" 1) - (dict-set! state "b" 2) - "done"))) + (deftest + "multi-body lambda side effects via dict mutation" + (let + ((state (dict "a" 0 "b" 0))) + (let + ((f (fn () (dict-set! state "a" 1) (dict-set! state "b" 2) "done"))) (assert-equal "done" (f)) (assert-equal 1 (get state "a")) (assert-equal 2 (get state "b"))))) - - (deftest "multi-body lambda two expressions" - ;; Simplest case: two body expressions, return value is second. - (assert-equal 20 + (deftest + "multi-body lambda two expressions" + (assert-equal + 20 ((fn (x) (+ x 1) (* x 2)) 10)) - ;; And with zero-arg lambda - (assert-equal 42 - ((fn () (+ 1 2) 42))))) + (assert-equal 42 ((fn () (+ 1 2) 42))))) ;; -------------------------------------------------------------------------- ;; Higher-order forms ;; -------------------------------------------------------------------------- -(defsuite "higher-order" - (deftest "map" - (assert-equal (list 2 4 6) - (map (fn (x) (* x 2)) (list 1 2 3))) +(defsuite + "higher-order" + (deftest + "map" + (assert-equal + (list 2 4 6) + (map + (fn (x) (* x 2)) + (list 1 2 3))) (assert-equal (list) (map (fn (x) x) (list)))) - - (deftest "filter" - (assert-equal (list 2 4) - (filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4))) - (assert-equal (list) + (deftest + "filter" + (assert-equal + (list 2 4) + (filter + (fn (x) (= (mod x 2) 0)) + (list 1 2 3 4))) + (assert-equal + (list) (filter (fn (x) false) (list 1 2 3)))) - - (deftest "reduce" - (assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4))) - (assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))) - - (deftest "some" - (assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5))) - (assert-false (some (fn (x) (> x 10)) (list 1 2 3)))) - - (deftest "every?" - (assert-true (every? (fn (x) (> x 0)) (list 1 2 3))) - (assert-false (every? (fn (x) (> x 2)) (list 1 2 3)))) - - (deftest "map-indexed" - (assert-equal (list "0:a" "1:b" "2:c") + (deftest + "reduce" + (assert-equal + 10 + (reduce + (fn (acc x) (+ acc x)) + 0 + (list 1 2 3 4))) + (assert-equal + 0 + (reduce (fn (acc x) (+ acc x)) 0 (list)))) + (deftest + "some" + (assert-true + (some + (fn (x) (> x 3)) + (list 1 2 3 4 5))) + (assert-false + (some + (fn (x) (> x 10)) + (list 1 2 3)))) + (deftest + "every?" + (assert-true + (every? + (fn (x) (> x 0)) + (list 1 2 3))) + (assert-false + (every? + (fn (x) (> x 2)) + (list 1 2 3)))) + (deftest + "map-indexed" + (assert-equal + (list "0:a" "1:b" "2:c") (map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c"))))) @@ -425,49 +486,39 @@ ;; Components ;; -------------------------------------------------------------------------- -(defsuite "components" - (deftest "defcomp creates component" - (defcomp ~test-comp (&key title) - (div title)) +(defsuite + "components" + (deftest + "defcomp creates component" + (defcomp ~test-comp (&key title) (div title)) (assert-true (not (nil? ~test-comp)))) - - (deftest "component renders with keyword args" - (defcomp ~greeting (&key name) - (span (str "Hello, " name "!"))) + (deftest + "component renders with keyword args" + (defcomp ~greeting (&key name) (span (str "Hello, " name "!"))) (assert-true (not (nil? ~greeting)))) - - (deftest "component with children" - (defcomp ~box (&key &rest children) - (div :class "box" children)) + (deftest + "component with children" + (defcomp ~box (&key &rest children) (div :class "box" children)) (assert-true (not (nil? ~box)))) - - (deftest "component with default via or" - (defcomp ~label (&key text) - (span (or text "default"))) + (deftest + "component with default via or" + (defcomp ~label (&key text) (span (or text "default"))) (assert-true (not (nil? ~label)))) - - (deftest "defcomp default affinity is auto" - (defcomp ~aff-default (&key x) - (div x)) + (deftest + "defcomp default affinity is auto" + (defcomp ~aff-default (&key x) (div x)) (assert-equal "auto" (component-affinity ~aff-default))) - - (deftest "defcomp affinity client" - (defcomp ~aff-client (&key x) - :affinity :client - (div x)) + (deftest + "defcomp affinity client" + (defcomp ~aff-client (&key x) :affinity :client (div x)) (assert-equal "client" (component-affinity ~aff-client))) - - (deftest "defcomp affinity server" - (defcomp ~aff-server (&key x) - :affinity :server - (div x)) + (deftest + "defcomp affinity server" + (defcomp ~aff-server (&key x) :affinity :server (div x)) (assert-equal "server" (component-affinity ~aff-server))) - - (deftest "defcomp affinity preserves body" - (defcomp ~aff-body (&key val) - :affinity :client - (span val)) - ;; Component should still render correctly + (deftest + "defcomp affinity preserves body" + (defcomp ~aff-body (&key val) :affinity :client (span val)) (assert-equal "client" (component-affinity ~aff-body)) (assert-true (not (nil? ~aff-body))))) @@ -476,93 +527,98 @@ ;; Macros ;; -------------------------------------------------------------------------- -(defsuite "macros" - (deftest "defmacro creates macro" - (defmacro unless (cond &rest body) - `(if (not ,cond) (do ,@body))) +(defsuite + "macros" + (deftest + "defmacro creates macro" + (defmacro + unless + (cond &rest body) + (quasiquote (if (not (unquote cond)) (do (splice-unquote body))))) (assert-equal "yes" (unless false "yes")) (assert-nil (unless true "no"))) - - (deftest "quasiquote and unquote" - (let ((x 42)) - (assert-equal (list 1 42 3) `(1 ,x 3)))) - - (deftest "splice-unquote" - (let ((xs (list 2 3 4))) - (assert-equal (list 1 2 3 4 5) `(1 ,@xs 5))))) + (deftest + "quasiquote and unquote" + (let + ((x 42)) + (assert-equal + (list 1 42 3) + (quasiquote (1 (unquote x) 3))))) + (deftest + "splice-unquote" + (let + ((xs (list 2 3 4))) + (assert-equal + (list 1 2 3 4 5) + (quasiquote (1 (splice-unquote xs) 5)))))) ;; -------------------------------------------------------------------------- ;; Threading macro ;; -------------------------------------------------------------------------- -(defsuite "threading" - (deftest "thread-first" +(defsuite + "threading" + (deftest + "thread-first" (assert-equal 8 (-> 5 (+ 1) (+ 2))) (assert-equal "HELLO" (-> "hello" upcase)) - (assert-equal "HELLO WORLD" - (-> "hello" - (str " world") - upcase)))) + (assert-equal "HELLO WORLD" (-> "hello" (str " world") upcase)))) ;; -------------------------------------------------------------------------- ;; Truthiness ;; -------------------------------------------------------------------------- -(defsuite "truthiness" - (deftest "truthy values" +(defsuite + "truthiness" + (deftest + "truthy values" (assert-true (if 1 true false)) (assert-true (if "x" true false)) (assert-true (if (list 1) true false)) (assert-true (if true true false))) - - (deftest "falsy values" + (deftest + "falsy values" (assert-false (if false true false)) - (assert-false (if nil true false))) - - ;; NOTE: empty list, zero, and empty string truthiness is - ;; platform-dependent. Python treats all three as falsy. - ;; JavaScript treats [] as truthy but 0 and "" as falsy. - ;; These tests are omitted — each bootstrapper should emit - ;; platform-specific truthiness tests instead. - ) + (assert-false (if nil true false)))) ;; -------------------------------------------------------------------------- ;; Edge cases and regression tests ;; -------------------------------------------------------------------------- -(defsuite "edge-cases" - (deftest "nested let scoping" - (let ((x 1)) - (let ((x 2)) - (assert-equal 2 x)) - ;; outer x should be unchanged by inner let - ;; (this tests that let creates a new scope) - )) - - (deftest "recursive map" - (assert-equal (list (list 2 4) (list 6 8)) - (map (fn (sub) (map (fn (x) (* x 2)) sub)) - (list (list 1 2) (list 3 4))))) - - (deftest "keyword as value" +(defsuite + "edge-cases" + (deftest + "nested let scoping" + (let + ((x 1)) + (let ((x 2)) (assert-equal 2 x)))) + (deftest + "recursive map" + (assert-equal + (list (list 2 4) (list 6 8)) + (map + (fn (sub) (map (fn (x) (* x 2)) sub)) + (list (list 1 2) (list 3 4))))) + (deftest + "keyword as value" (assert-equal "class" :class) (assert-equal "id" :id)) - - (deftest "dict with evaluated values" - (let ((x 42)) - (assert-equal 42 (get {:val x} "val")))) - - (deftest "nil propagation" + (deftest + "dict with evaluated values" + (let ((x 42)) (assert-equal 42 (get {:val x} "val")))) + (deftest + "nil propagation" (assert-nil (get {:a 1} "missing")) (assert-equal "default" (or (get {:a 1} "missing") "default"))) - - (deftest "empty operations" + (deftest + "empty operations" (assert-equal (list) (map (fn (x) x) (list))) (assert-equal (list) (filter (fn (x) true) (list))) - (assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))) + (assert-equal + 0 + (reduce (fn (acc x) (+ acc x)) 0 (list))) (assert-equal 0 (len (list))) (assert-equal "" (str)))) - diff --git a/spec/tests/test-numeric-tower.sx b/spec/tests/test-numeric-tower.sx index b6b6057d..61fd3d25 100644 --- a/spec/tests/test-numeric-tower.sx +++ b/spec/tests/test-numeric-tower.sx @@ -1,4 +1,3 @@ - ;; ========================================================================== ;; test-numeric-tower.sx — Numeric tower: Integer vs Float distinction ;; @@ -52,15 +51,20 @@ (assert (float? (exact->inexact 5))))) ;; -------------------------------------------------------------------------- -;; Division always returns float +;; Division ;; -------------------------------------------------------------------------- (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))))) + (deftest + "exact division value" + (assert= (/ 6 2) 3)) + (deftest "inexact division value" (assert= (/ 1 4) 0.25)) + (deftest "float / float = float" (assert (float? (/ 3.5 2.5)))) + (deftest + "rational / int = rational" + (assert (rational? (/ 1/2 2)))) + (deftest "rational division value" (assert= (/ 1/2 2) 1/4))) ;; -------------------------------------------------------------------------- ;; Type predicates @@ -82,8 +86,10 @@ (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 rational" (assert (number? 1/3))) (deftest "number? on string" (assert (not (number? "42")))) (deftest "exact? on int" (assert (exact? 1))) + (deftest "exact? on rational" (assert (exact? 1/3))) (deftest "exact? on exact->inexact" (assert (not (exact? (exact->inexact 1))))) @@ -96,13 +102,16 @@ (defsuite "numeric-tower:coercions" - (deftest "exact->inexact int" (assert= (exact->inexact 3) 3)) + (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 "exact->inexact rational" (assert= (exact->inexact 1/4) 0.25)) (deftest "inexact->exact 1.5" (assert= (inexact->exact 1.5) 2)) (deftest "inexact->exact produces int" diff --git a/spec/tests/test-primitives.sx b/spec/tests/test-primitives.sx index c5749887..d9f0053f 100644 --- a/spec/tests/test-primitives.sx +++ b/spec/tests/test-primitives.sx @@ -6,20 +6,36 @@ ;; Arithmetic ;; -------------------------------------------------------------------------- -(defsuite "arithmetic" +(defsuite + "arithmetic" (deftest "add" (assert-equal 3 (+ 1 2))) - (deftest "add multiple" (assert-equal 10 (+ 1 2 3 4))) + (deftest + "add multiple" + (assert-equal 10 (+ 1 2 3 4))) (deftest "add zero" (assert-equal 5 (+ 5 0))) - (deftest "add negative" (assert-equal -1 (+ 1 -2))) + (deftest + "add negative" + (assert-equal -1 (+ 1 -2))) (deftest "subtract" (assert-equal 3 (- 5 2))) - (deftest "subtract negative" (assert-equal 7 (- 5 -2))) + (deftest + "subtract negative" + (assert-equal 7 (- 5 -2))) (deftest "multiply" (assert-equal 12 (* 3 4))) - (deftest "multiply zero" (assert-equal 0 (* 5 0))) - (deftest "multiply negative" (assert-equal -6 (* 2 -3))) + (deftest + "multiply zero" + (assert-equal 0 (* 5 0))) + (deftest + "multiply negative" + (assert-equal -6 (* 2 -3))) (deftest "divide" (assert-equal 3 (/ 9 3))) (deftest "divide float" (assert-equal 2.5 (/ 5 2))) (deftest "mod" (assert-equal 1 (mod 7 3))) - (deftest "mod negative" (assert-true (or (= (mod -1 3) 2) (= (mod -1 3) -1)))) + (deftest + "mod negative" + (assert-true + (or + (= (mod -1 3) 2) + (= (mod -1 3) -1)))) (deftest "inc" (assert-equal 6 (inc 5))) (deftest "dec" (assert-equal 4 (dec 5))) (deftest "abs positive" (assert-equal 5 (abs 5))) @@ -32,7 +48,8 @@ ;; Comparison ;; -------------------------------------------------------------------------- -(defsuite "comparison" +(defsuite + "comparison" (deftest "equal numbers" (assert-true (= 1 1))) (deftest "not equal numbers" (assert-false (= 1 2))) (deftest "equal strings" (assert-true (= "a" "a"))) @@ -52,7 +69,8 @@ ;; Predicates ;; -------------------------------------------------------------------------- -(defsuite "predicates" +(defsuite + "predicates" (deftest "nil? nil" (assert-true (nil? nil))) (deftest "nil? number" (assert-false (nil? 0))) (deftest "nil? string" (assert-false (nil? ""))) @@ -76,15 +94,22 @@ ;; String operations ;; -------------------------------------------------------------------------- -(defsuite "strings" - (deftest "str concat" (assert-equal "hello world" (str "hello" " " "world"))) +(defsuite + "strings" + (deftest + "str concat" + (assert-equal "hello world" (str "hello" " " "world"))) (deftest "str number" (assert-equal "42" (str 42))) (deftest "str empty" (assert-equal "" (str))) (deftest "len string" (assert-equal 5 (len "hello"))) (deftest "len empty" (assert-equal 0 (len ""))) - (deftest "slice" (assert-equal "ell" (slice "hello" 1 4))) + (deftest + "slice" + (assert-equal "ell" (slice "hello" 1 4))) (deftest "slice from" (assert-equal "llo" (slice "hello" 2))) - (deftest "slice empty" (assert-equal "" (slice "hello" 2 2))) + (deftest + "slice empty" + (assert-equal "" (slice "hello" 2 2))) (deftest "join" (assert-equal "a,b,c" (join "," (list "a" "b" "c")))) (deftest "join empty" (assert-equal "" (join "," (list)))) (deftest "join single" (assert-equal "a" (join "," (list "a")))) @@ -101,88 +126,238 @@ (deftest "replace" (assert-equal "hXllo" (replace "hello" "e" "X"))) (deftest "string-length" (assert-equal 5 (string-length "hello"))) (deftest "index-of found" (assert-equal 2 (index-of "hello" "l"))) - (deftest "index-of not found" (assert-equal -1 (index-of "hello" "z")))) + (deftest + "index-of not found" + (assert-equal -1 (index-of "hello" "z")))) ;; -------------------------------------------------------------------------- ;; List operations ;; -------------------------------------------------------------------------- -(defsuite "lists" - (deftest "list create" (assert-equal (list 1 2 3) (list 1 2 3))) - (deftest "first" (assert-equal 1 (first (list 1 2 3)))) +(defsuite + "lists" + (deftest + "list create" + (assert-equal + (list 1 2 3) + (list 1 2 3))) + (deftest + "first" + (assert-equal 1 (first (list 1 2 3)))) (deftest "first empty" (assert-nil (first (list)))) - (deftest "rest" (assert-equal (list 2 3) (rest (list 1 2 3)))) + (deftest + "rest" + (assert-equal + (list 2 3) + (rest (list 1 2 3)))) (deftest "rest single" (assert-equal (list) (rest (list 1)))) (deftest "rest empty" (assert-equal (list) (rest (list)))) - (deftest "nth" (assert-equal 2 (nth (list 1 2 3) 1))) - (deftest "nth out of bounds" (assert-nil (nth (list 1 2) 5))) - (deftest "last" (assert-equal 3 (last (list 1 2 3)))) + (deftest + "nth" + (assert-equal + 2 + (nth (list 1 2 3) 1))) + (deftest + "nth out of bounds" + (assert-nil (nth (list 1 2) 5))) + (deftest + "last" + (assert-equal 3 (last (list 1 2 3)))) (deftest "last single" (assert-equal 1 (last (list 1)))) - (deftest "len list" (assert-equal 3 (len (list 1 2 3)))) + (deftest + "len list" + (assert-equal 3 (len (list 1 2 3)))) (deftest "len empty" (assert-equal 0 (len (list)))) - (deftest "cons" (assert-equal (list 0 1 2) (cons 0 (list 1 2)))) - (deftest "append" (assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4)))) - (deftest "append element" (assert-equal (list 1 2 3) (append (list 1 2) (list 3)))) - (deftest "slice list" (assert-equal (list 2 3) (slice (list 1 2 3 4) 1 3))) - (deftest "concat" (assert-equal (list 1 2 3 4) (concat (list 1 2) (list 3 4)))) - (deftest "reverse" (assert-equal (list 3 2 1) (reverse (list 1 2 3)))) + (deftest + "cons" + (assert-equal + (list 0 1 2) + (cons 0 (list 1 2)))) + (deftest + "append" + (assert-equal + (list 1 2 3 4) + (append (list 1 2) (list 3 4)))) + (deftest + "append element" + (assert-equal + (list 1 2 3) + (append (list 1 2) (list 3)))) + (deftest + "slice list" + (assert-equal + (list 2 3) + (slice + (list 1 2 3 4) + 1 + 3))) + (deftest + "concat" + (assert-equal + (list 1 2 3 4) + (concat (list 1 2) (list 3 4)))) + (deftest + "reverse" + (assert-equal + (list 3 2 1) + (reverse (list 1 2 3)))) (deftest "reverse empty" (assert-equal (list) (reverse (list)))) - (deftest "contains? list" (assert-true (contains? (list 1 2 3) 2))) - (deftest "contains? list false" (assert-false (contains? (list 1 2 3) 5))) - (deftest "range" (assert-equal (list 0 1 2) (range 0 3))) - (deftest "range step" (assert-equal (list 0 2 4) (range 0 6 2))) - (deftest "flatten" (assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4)))))) + (deftest + "contains? list" + (assert-true + (contains? (list 1 2 3) 2))) + (deftest + "contains? list false" + (assert-false + (contains? (list 1 2 3) 5))) + (deftest + "range" + (assert-equal + (list 0 1 2) + (range 0 3))) + (deftest + "range step" + (assert-equal + (list 0 2 4) + (range 0 6 2))) + (deftest + "flatten" + (assert-equal + (list 1 2 3 4) + (flatten + (list (list 1 2) (list 3 4)))))) ;; -------------------------------------------------------------------------- ;; Dict operations ;; -------------------------------------------------------------------------- -(defsuite "dicts" - (deftest "dict create" (assert-equal 1 (get (dict "a" 1 "b" 2) "a"))) +(defsuite + "dicts" + (deftest + "dict create" + (assert-equal 1 (get (dict "a" 1 "b" 2) "a"))) (deftest "get missing" (assert-nil (get (dict "a" 1) "z"))) - (deftest "get default" (assert-equal 99 (get (dict "a" 1) "z" 99))) - (deftest "keys" (assert-true (contains? (keys (dict "a" 1 "b" 2)) "a"))) + (deftest + "get default" + (assert-equal 99 (get (dict "a" 1) "z" 99))) + (deftest + "keys" + (assert-true + (contains? (keys (dict "a" 1 "b" 2)) "a"))) (deftest "has-key?" (assert-true (has-key? (dict "a" 1) "a"))) - (deftest "has-key? false" (assert-false (has-key? (dict "a" 1) "z"))) - (deftest "assoc" (assert-equal 2 (get (assoc (dict "a" 1) "b" 2) "b"))) - (deftest "dissoc" (assert-false (has-key? (dissoc (dict "a" 1 "b" 2) "a") "a"))) - (deftest "len dict" (assert-equal 2 (len (dict "a" 1 "b" 2)))) + (deftest + "has-key? false" + (assert-false (has-key? (dict "a" 1) "z"))) + (deftest + "assoc" + (assert-equal + 2 + (get (assoc (dict "a" 1) "b" 2) "b"))) + (deftest + "dissoc" + (assert-false + (has-key? (dissoc (dict "a" 1 "b" 2) "a") "a"))) + (deftest + "len dict" + (assert-equal 2 (len (dict "a" 1 "b" 2)))) (deftest "len empty dict" (assert-equal 0 (len (dict)))) (deftest "empty? dict" (assert-true (empty? (dict)))) - (deftest "empty? nonempty dict" (assert-false (empty? (dict "a" 1))))) + (deftest + "empty? nonempty dict" + (assert-false (empty? (dict "a" 1))))) ;; -------------------------------------------------------------------------- ;; Higher-order functions ;; -------------------------------------------------------------------------- -(defsuite "higher-order" - (deftest "map" (assert-equal (list 2 4 6) (map (fn (x) (* x 2)) (list 1 2 3)))) +(defsuite + "higher-order" + (deftest + "map" + (assert-equal + (list 2 4 6) + (map + (fn (x) (* x 2)) + (list 1 2 3)))) (deftest "map empty" (assert-equal (list) (map (fn (x) x) (list)))) - (deftest "filter" (assert-equal (list 2 4) (filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4 5)))) - (deftest "filter none" (assert-equal (list) (filter (fn (x) false) (list 1 2 3)))) - (deftest "reduce" (assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))) - (deftest "reduce empty" (assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))) - (deftest "some true" (assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))) - (deftest "some false" (assert-false (some (fn (x) (> x 10)) (list 1 2 3)))) + (deftest + "filter" + (assert-equal + (list 2 4) + (filter + (fn (x) (= (mod x 2) 0)) + (list 1 2 3 4 5)))) + (deftest + "filter none" + (assert-equal + (list) + (filter (fn (x) false) (list 1 2 3)))) + (deftest + "reduce" + (assert-equal + 10 + (reduce + (fn (acc x) (+ acc x)) + 0 + (list 1 2 3 4)))) + (deftest + "reduce empty" + (assert-equal + 0 + (reduce (fn (acc x) (+ acc x)) 0 (list)))) + (deftest + "some true" + (assert-true + (some + (fn (x) (> x 3)) + (list 1 2 3 4 5)))) + (deftest + "some false" + (assert-false + (some + (fn (x) (> x 10)) + (list 1 2 3)))) (deftest "some empty" (assert-false (some (fn (x) true) (list)))) - (deftest "every? true" (assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))) - (deftest "every? false" (assert-false (every? (fn (x) (> x 2)) (list 1 2 3)))) + (deftest + "every? true" + (assert-true + (every? + (fn (x) (> x 0)) + (list 1 2 3)))) + (deftest + "every? false" + (assert-false + (every? + (fn (x) (> x 2)) + (list 1 2 3)))) (deftest "every? empty" (assert-true (every? (fn (x) false) (list)))) - (deftest "for-each returns nil" - (let ((log (list))) - (for-each (fn (x) (append! log x)) (list 1 2 3)) + (deftest + "for-each returns nil" + (let + ((log (list))) + (for-each + (fn (x) (append! log x)) + (list 1 2 3)) (assert-equal (list 1 2 3) log))) - (deftest "map-indexed" - (assert-equal (list (list 0 "a") (list 1 "b")) + (deftest + "map-indexed" + (assert-equal + (list (list 0 "a") (list 1 "b")) (map-indexed (fn (i x) (list i x)) (list "a" "b"))))) ;; -------------------------------------------------------------------------- ;; Type coercion ;; -------------------------------------------------------------------------- -(defsuite "type-coercion" - (deftest "str bool" (assert-true (or (= (str true) "true") (= (str true) "True")))) +(defsuite + "type-coercion" + (deftest + "str bool" + (assert-true (or (= (str true) "true") (= (str true) "True")))) (deftest "str nil" (assert-equal "" (str nil))) - (deftest "str list" (assert-true (not (empty? (str (list 1 2 3)))))) + (deftest + "str list" + (assert-true + (not (empty? (str (list 1 2 3)))))) (deftest "parse-int" (assert-equal 42 (parse-int "42"))) (deftest "parse-float skipped" (assert-true true))) diff --git a/spec/tests/test-rationals.sx b/spec/tests/test-rationals.sx new file mode 100644 index 00000000..3f3150ae --- /dev/null +++ b/spec/tests/test-rationals.sx @@ -0,0 +1,135 @@ +;; ========================================================================== +;; test-rationals.sx — Rational number type: literals, arithmetic, tower +;; +;; Note: in the JS host, (/ int int) returns float (backward-compatible). +;; Use rational literals (1/3, 3/4) or make-rational for exact rationals. +;; ========================================================================== + +;; -------------------------------------------------------------------------- +;; Literals and type +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:literals" + (deftest "1/3 is rational" (assert (rational? 1/3))) + (deftest "1/2 is rational" (assert (rational? 1/2))) + (deftest "2/3 is rational" (assert (rational? 2/3))) + (deftest "literal numerator 1/3" (assert= (numerator 1/3) 1)) + (deftest "literal denominator 1/3" (assert= (denominator 1/3) 3)) + (deftest "literal numerator 2/3" (assert= (numerator 2/3) 2)) + (deftest "auto-reduce 2/4 = 1/2" (assert= 2/4 1/2)) + (deftest "auto-reduce 6/9 = 2/3" (assert= 6/9 2/3)) + (deftest "negative literal" (assert= (numerator -1/3) -1))) + +;; -------------------------------------------------------------------------- +;; Constructor and predicates +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:constructor" + (deftest + "make-rational basic" + (assert (rational? (make-rational 1 3)))) + (deftest + "make-rational reduces" + (assert= (make-rational 2 4) 1/2)) + (deftest + "make-rational exact int" + (assert (integer? (make-rational 6 3)))) + (deftest + "make-rational 6/3 = 2" + (assert= (make-rational 6 3) 2)) + (deftest + "make-rational negative" + (assert= (numerator (make-rational -1 3)) -1)) + (deftest + "make-rational neg denom" + (assert= (numerator (make-rational 1 -3)) -1)) + (deftest "rational? on int" (assert (not (rational? 5)))) + (deftest "rational? on float" (assert (not (rational? 1.5)))) + (deftest "rational? on string" (assert (not (rational? "1/2")))) + (deftest "number? on rational" (assert (number? 1/3))) + (deftest "exact? on rational" (assert (exact? 1/3))) + (deftest "inexact? on rational" (assert (not (inexact? 1/3)))) + (deftest "integer? on rational" (assert (not (integer? 1/3)))) + (deftest "dict? on rational" (assert (not (dict? 1/3))))) + +;; -------------------------------------------------------------------------- +;; Accessors +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:accessors" + (deftest "numerator 1/3" (assert= (numerator 1/3) 1)) + (deftest "denominator 1/3" (assert= (denominator 1/3) 3)) + (deftest "numerator 3/4" (assert= (numerator 3/4) 3)) + (deftest "denominator 3/4" (assert= (denominator 3/4) 4)) + (deftest "numerator of int" (assert= (numerator 5) 5)) + (deftest + "denominator of int" + (assert= (denominator 5) 1))) + +;; -------------------------------------------------------------------------- +;; Arithmetic +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:arithmetic" + (deftest "add two rationals" (assert= (+ 1/3 1/3) 2/3)) + (deftest "add to integer" (assert= (+ 1 1/2) 3/2)) + (deftest "add integer to rational" (assert= (+ 1/2 1) 3/2)) + (deftest "add reduces" (assert= (+ 1/6 1/6) 1/3)) + (deftest "add to whole number" (assert (integer? (+ 1/2 1/2)))) + (deftest "add whole = 1" (assert= (+ 1/2 1/2) 1)) + (deftest "subtract rationals" (assert= (- 3/4 1/4) 1/2)) + (deftest "subtract int from rational" (assert= (- 3/2 1) 1/2)) + (deftest "negate rational" (assert= (- 1/3) -1/3)) + (deftest "multiply rationals" (assert= (* 2/3 3/4) 1/2)) + (deftest "multiply int and rational" (assert= (* 2 1/3) 2/3)) + (deftest "multiply reduces to int" (assert (integer? (* 3 1/3)))) + (deftest "divide rational by int" (assert= (/ 2/3 2) 1/3)) + (deftest "divide rational by rational" (assert= (/ 1/2 1/4) 2)) + (deftest + "divide rational gives int when exact" + (assert (integer? (/ 1/2 1/2))))) + +;; -------------------------------------------------------------------------- +;; Float contagion +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:float-contagion" + (deftest "rational + float = float" (assert (float? (+ 1/3 0.5)))) + (deftest "float + rational = float" (assert (float? (+ 0.5 1/3)))) + (deftest "rational * float = float" (assert (float? (* 1/2 2)))) + (deftest "rational - float = float" (assert (float? (- 1/2 0.1))))) + +;; -------------------------------------------------------------------------- +;; Comparison +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:comparison" + (deftest "equal rationals" (assert (= 1/2 1/2))) + (deftest "equal reduced" (assert (= 2/4 1/2))) + (deftest "not equal" (assert (not (= 1/3 1/2)))) + (deftest "less than" (assert (< 1/3 1/2))) + (deftest "less than int" (assert (< 1/3 1))) + (deftest "greater than" (assert (> 2/3 1/2))) + (deftest "less equal" (assert (<= 1/3 1/3))) + (deftest "greater equal" (assert (>= 2/3 2/3))) + (deftest "rational less than float" (assert (< 1/3 0.5)))) + +;; -------------------------------------------------------------------------- +;; Coercion +;; -------------------------------------------------------------------------- + +(defsuite + "rationals:coercion" + (deftest "exact->inexact 1/2" (assert= (exact->inexact 1/2) 0.5)) + (deftest "exact->inexact 1/4" (assert= (exact->inexact 1/4) 0.25)) + (deftest + "exact->inexact 1/3 is float" + (assert (float? (exact->inexact 1/3)))) + (deftest "number->string 1/2" (assert= (number->string 1/2) "1/2")) + (deftest "number->string 3/4" (assert= (number->string 3/4) "3/4"))) diff --git a/spec/tests/test.sx b/spec/tests/test.sx index 30d7184b..403d6471 100644 --- a/spec/tests/test.sx +++ b/spec/tests/test.sx @@ -1,195 +1,156 @@ ;; ========================================================================== ;; test.sx — Self-hosting SX test suite (backward-compatible entry point) -;; -;; This file includes the test framework and core eval tests inline. -;; It exists for backward compatibility — runners that load "test.sx" -;; get the same 81 tests as before. -;; -;; For modular testing, runners should instead load: -;; 1. test-framework.sx (macros + assertions) -;; 2. One or more test specs: test-eval.sx, test-parser.sx, -;; test-router.sx, test-render.sx, etc. -;; -;; Platform functions required: -;; try-call (thunk) -> {:ok true} | {:ok false :error "msg"} -;; report-pass (name) -> platform-specific pass output -;; report-fail (name error) -> platform-specific fail output -;; push-suite (name) -> push suite name onto context stack -;; pop-suite () -> pop suite name from context stack -;; -;; Usage: -;; ;; Host injects platform functions into env, then: -;; (eval-file "test.sx" env) -;; -;; The same test.sx runs on every host — Python, JavaScript, etc. ;; ========================================================================== +(defmacro + deftest + (name &rest body) + (quasiquote + (let + ((result (try-call (fn () (splice-unquote body))))) + (if + (get result "ok") + (report-pass (unquote name)) + (report-fail (unquote name) (get result "error")))))) -;; -------------------------------------------------------------------------- -;; 1. Test framework macros -;; -------------------------------------------------------------------------- -;; -;; deftest and defsuite are macros that make test.sx directly executable. -;; The host provides try-call (error catching), reporting, and suite -;; context — everything else is pure SX. +(defmacro + defsuite + (name &rest items) + (quasiquote + (do (push-suite (unquote name)) (splice-unquote items) (pop-suite)))) -(defmacro deftest (name &rest body) - `(let ((result (try-call (fn () ,@body)))) - (if (get result "ok") - (report-pass ,name) - (report-fail ,name (get result "error"))))) - -(defmacro defsuite (name &rest items) - `(do (push-suite ,name) - ,@items - (pop-suite))) - - -;; -------------------------------------------------------------------------- -;; 2. Assertion helpers — defined in SX, available in test bodies -;; -------------------------------------------------------------------------- -;; -;; These are regular functions (not special forms). They use the `assert` -;; primitive underneath but provide better error messages. - -(define assert-equal - (fn (expected actual) - (assert (equal? expected actual) +(define + assert-equal + (fn + (expected actual) + (assert + (equal? expected actual) (str "Expected " (str expected) " but got " (str actual))))) -(define assert-not-equal - (fn (a b) - (assert (not (equal? a b)) +(define + assert-not-equal + (fn + (a b) + (assert + (not (equal? a b)) (str "Expected values to differ but both are " (str a))))) -(define assert-true - (fn (val) - (assert val (str "Expected truthy but got " (str val))))) +(define + assert-true + (fn (val) (assert val (str "Expected truthy but got " (str val))))) -(define assert-false - (fn (val) - (assert (not val) (str "Expected falsy but got " (str val))))) +(define + assert-false + (fn (val) (assert (not val) (str "Expected falsy but got " (str val))))) -(define assert-nil - (fn (val) - (assert (nil? val) (str "Expected nil but got " (str val))))) +(define + assert-nil + (fn (val) (assert (nil? val) (str "Expected nil but got " (str val))))) -(define assert-type - (fn (expected-type val) - ;; Implemented via predicate dispatch since type-of is a platform - ;; function not available in all hosts. Uses nested if to avoid - ;; Scheme-style cond detection for 2-element predicate calls. - ;; Boolean checked before number (subtypes on some platforms). - (let ((actual-type - (if (nil? val) "nil" - (if (boolean? val) "boolean" - (if (number? val) "number" - (if (string? val) "string" - (if (list? val) "list" - (if (dict? val) "dict" - "unknown")))))))) - (assert (= expected-type actual-type) +(define + assert-type + (fn + (expected-type val) + (let + ((actual-type (if (nil? val) "nil" (if (boolean? val) "boolean" (if (number? val) "number" (if (string? val) "string" (if (list? val) "list" (if (dict? val) "dict" "unknown")))))))) + (assert + (= expected-type actual-type) (str "Expected type " expected-type " but got " actual-type))))) -(define assert-length - (fn (expected-len col) - (assert (= (len col) expected-len) +(define + assert-length + (fn + (expected-len col) + (assert + (= (len col) expected-len) (str "Expected length " expected-len " but got " (len col))))) -(define assert-contains - (fn (item col) - (assert (some (fn (x) (equal? x item)) col) +(define + assert-contains + (fn + (item col) + (assert + (some (fn (x) (equal? x item)) col) (str "Expected collection to contain " (str item))))) -(define assert-throws - (fn (thunk) - (let ((result (try-call thunk))) - (assert (not (get result "ok")) +(define + assert-throws + (fn + (thunk) + (let + ((result (try-call thunk))) + (assert + (not (get result "ok")) "Expected an error to be thrown but none was")))) - -;; ========================================================================== -;; 3. Test suites — SX testing SX -;; ========================================================================== - - -;; -------------------------------------------------------------------------- -;; 3a. Literals and types -;; -------------------------------------------------------------------------- - -(defsuite "literals" - (deftest "numbers are numbers" +(defsuite + "literals" + (deftest + "numbers are numbers" (assert-type "number" 42) (assert-type "number" 3.14) (assert-type "number" -1)) - - (deftest "strings are strings" + (deftest + "strings are strings" (assert-type "string" "hello") (assert-type "string" "")) - - (deftest "booleans are booleans" + (deftest + "booleans are booleans" (assert-type "boolean" true) (assert-type "boolean" false)) - - (deftest "nil is nil" - (assert-type "nil" nil) - (assert-nil nil)) - - (deftest "lists are lists" + (deftest "nil is nil" (assert-type "nil" nil) (assert-nil nil)) + (deftest + "lists are lists" (assert-type "list" (list 1 2 3)) (assert-type "list" (list))) + (deftest "dicts are dicts" (assert-type "dict" {:b 2 :a 1}))) - (deftest "dicts are dicts" - (assert-type "dict" {:a 1 :b 2}))) - - -;; -------------------------------------------------------------------------- -;; 3b. Arithmetic -;; -------------------------------------------------------------------------- - -(defsuite "arithmetic" - (deftest "addition" +(defsuite + "arithmetic" + (deftest + "addition" (assert-equal 3 (+ 1 2)) (assert-equal 0 (+ 0 0)) (assert-equal -1 (+ 1 -2)) (assert-equal 10 (+ 1 2 3 4))) - - (deftest "subtraction" + (deftest + "subtraction" (assert-equal 1 (- 3 2)) (assert-equal -1 (- 2 3))) - - (deftest "multiplication" + (deftest + "multiplication" (assert-equal 6 (* 2 3)) (assert-equal 0 (* 0 100)) (assert-equal 24 (* 1 2 3 4))) - - (deftest "division" + (deftest + "division" (assert-equal 2 (/ 6 3)) (assert-equal 2.5 (/ 5 2))) - - (deftest "modulo" + (deftest + "modulo" (assert-equal 1 (mod 7 3)) (assert-equal 0 (mod 6 3)))) - -;; -------------------------------------------------------------------------- -;; 3c. Comparison -;; -------------------------------------------------------------------------- - -(defsuite "comparison" - (deftest "equality" +(defsuite + "comparison" + (deftest + "equality" (assert-true (= 1 1)) (assert-false (= 1 2)) (assert-true (= "a" "a")) (assert-false (= "a" "b"))) - - (deftest "deep equality" - (assert-true (equal? (list 1 2 3) (list 1 2 3))) - (assert-false (equal? (list 1 2) (list 1 3))) + (deftest + "deep equality" + (assert-true + (equal? + (list 1 2 3) + (list 1 2 3))) + (assert-false + (equal? (list 1 2) (list 1 3))) (assert-true (equal? {:a 1} {:a 1})) (assert-false (equal? {:a 1} {:a 2}))) - - (deftest "ordering" + (deftest + "ordering" (assert-true (< 1 2)) (assert-false (< 2 1)) (assert-true (> 2 1)) @@ -198,405 +159,418 @@ (assert-true (>= 2 2)) (assert-true (>= 3 2)))) - -;; -------------------------------------------------------------------------- -;; 3d. String operations -;; -------------------------------------------------------------------------- - -(defsuite "strings" - (deftest "str concatenation" +(defsuite + "strings" + (deftest + "str concatenation" (assert-equal "abc" (str "a" "b" "c")) (assert-equal "hello world" (str "hello" " " "world")) (assert-equal "42" (str 42)) (assert-equal "" (str))) - - (deftest "string-length" + (deftest + "string-length" (assert-equal 5 (string-length "hello")) (assert-equal 0 (string-length ""))) - - (deftest "substring" + (deftest + "substring" (assert-equal "ell" (substring "hello" 1 4)) (assert-equal "hello" (substring "hello" 0 5))) - - (deftest "string-contains?" + (deftest + "string-contains?" (assert-true (string-contains? "hello world" "world")) (assert-false (string-contains? "hello" "xyz"))) - - (deftest "upcase and downcase" + (deftest + "upcase and downcase" (assert-equal "HELLO" (upcase "hello")) (assert-equal "hello" (downcase "HELLO"))) - - (deftest "trim" + (deftest + "trim" (assert-equal "hello" (trim " hello ")) (assert-equal "hello" (trim "hello"))) - - (deftest "split and join" + (deftest + "split and join" (assert-equal (list "a" "b" "c") (split "a,b,c" ",")) (assert-equal "a-b-c" (join "-" (list "a" "b" "c"))))) - -;; -------------------------------------------------------------------------- -;; 3e. List operations -;; -------------------------------------------------------------------------- - -(defsuite "lists" - (deftest "constructors" - (assert-equal (list 1 2 3) (list 1 2 3)) +(defsuite + "lists" + (deftest + "constructors" + (assert-equal + (list 1 2 3) + (list 1 2 3)) (assert-equal (list) (list)) (assert-length 3 (list 1 2 3))) - - (deftest "first and rest" + (deftest + "first and rest" (assert-equal 1 (first (list 1 2 3))) - (assert-equal (list 2 3) (rest (list 1 2 3))) + (assert-equal + (list 2 3) + (rest (list 1 2 3))) (assert-nil (first (list))) (assert-equal (list) (rest (list)))) - - (deftest "nth" - (assert-equal 1 (nth (list 1 2 3) 0)) - (assert-equal 2 (nth (list 1 2 3) 1)) - (assert-equal 3 (nth (list 1 2 3) 2))) - - (deftest "last" + (deftest + "nth" + (assert-equal + 1 + (nth (list 1 2 3) 0)) + (assert-equal + 2 + (nth (list 1 2 3) 1)) + (assert-equal + 3 + (nth (list 1 2 3) 2))) + (deftest + "last" (assert-equal 3 (last (list 1 2 3))) (assert-nil (last (list)))) - - (deftest "cons and append" - (assert-equal (list 0 1 2) (cons 0 (list 1 2))) - (assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4)))) - - (deftest "reverse" - (assert-equal (list 3 2 1) (reverse (list 1 2 3))) + (deftest + "cons and append" + (assert-equal + (list 0 1 2) + (cons 0 (list 1 2))) + (assert-equal + (list 1 2 3 4) + (append (list 1 2) (list 3 4)))) + (deftest + "reverse" + (assert-equal + (list 3 2 1) + (reverse (list 1 2 3))) (assert-equal (list) (reverse (list)))) - - (deftest "empty?" + (deftest + "empty?" (assert-true (empty? (list))) (assert-false (empty? (list 1)))) - - (deftest "len" + (deftest + "len" (assert-equal 0 (len (list))) (assert-equal 3 (len (list 1 2 3)))) + (deftest + "contains?" + (assert-true + (contains? (list 1 2 3) 2)) + (assert-false + (contains? (list 1 2 3) 4))) + (deftest + "flatten" + (assert-equal + (list 1 2 3 4) + (flatten + (list (list 1 2) (list 3 4)))))) - (deftest "contains?" - (assert-true (contains? (list 1 2 3) 2)) - (assert-false (contains? (list 1 2 3) 4))) - - (deftest "flatten" - (assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4)))))) - - -;; -------------------------------------------------------------------------- -;; 3f. Dict operations -;; -------------------------------------------------------------------------- - -(defsuite "dicts" - (deftest "dict literal" - (assert-type "dict" {:a 1 :b 2}) +(defsuite + "dicts" + (deftest + "dict literal" + (assert-type "dict" {:b 2 :a 1}) (assert-equal 1 (get {:a 1} "a")) - (assert-equal 2 (get {:a 1 :b 2} "b"))) - - (deftest "assoc" - (assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2)) + (assert-equal 2 (get {:b 2 :a 1} "b"))) + (deftest + "assoc" + (assert-equal {:b 2 :a 1} (assoc {:a 1} "b" 2)) (assert-equal {:a 99} (assoc {:a 1} "a" 99))) - - (deftest "dissoc" - (assert-equal {:b 2} (dissoc {:a 1 :b 2} "a"))) - - (deftest "keys and vals" - (let ((d {:a 1 :b 2})) + (deftest "dissoc" (assert-equal {:b 2} (dissoc {:b 2 :a 1} "a"))) + (deftest + "keys and vals" + (let + ((d {:b 2 :a 1})) (assert-length 2 (keys d)) (assert-length 2 (vals d)) (assert-contains "a" (keys d)) (assert-contains "b" (keys d)))) - - (deftest "has-key?" + (deftest + "has-key?" (assert-true (has-key? {:a 1} "a")) (assert-false (has-key? {:a 1} "b"))) + (deftest + "merge" + (assert-equal {:c 3 :b 2 :a 1} (merge {:b 2 :a 1} {:c 3})) + (assert-equal {:b 2 :a 99} (merge {:b 2 :a 1} {:a 99})))) - (deftest "merge" - (assert-equal {:a 1 :b 2 :c 3} - (merge {:a 1 :b 2} {:c 3})) - (assert-equal {:a 99 :b 2} - (merge {:a 1 :b 2} {:a 99})))) - - -;; -------------------------------------------------------------------------- -;; 3g. Predicates -;; -------------------------------------------------------------------------- - -(defsuite "predicates" - (deftest "nil?" +(defsuite + "predicates" + (deftest + "nil?" (assert-true (nil? nil)) (assert-false (nil? 0)) (assert-false (nil? false)) (assert-false (nil? ""))) - - (deftest "number?" + (deftest + "number?" (assert-true (number? 42)) (assert-true (number? 3.14)) (assert-false (number? "42"))) - - (deftest "string?" + (deftest + "string?" (assert-true (string? "hello")) (assert-false (string? 42))) - - (deftest "list?" + (deftest + "list?" (assert-true (list? (list 1 2))) (assert-false (list? "not a list"))) - - (deftest "dict?" + (deftest + "dict?" (assert-true (dict? {:a 1})) (assert-false (dict? (list 1)))) - - (deftest "boolean?" + (deftest + "boolean?" (assert-true (boolean? true)) (assert-true (boolean? false)) (assert-false (boolean? nil)) (assert-false (boolean? 0))) - - (deftest "not" + (deftest + "not" (assert-true (not false)) (assert-true (not nil)) (assert-false (not true)) (assert-false (not 1)) (assert-false (not "x")))) - -;; -------------------------------------------------------------------------- -;; 3h. Special forms -;; -------------------------------------------------------------------------- - -(defsuite "special-forms" - (deftest "if" +(defsuite + "special-forms" + (deftest + "if" (assert-equal "yes" (if true "yes" "no")) (assert-equal "no" (if false "yes" "no")) (assert-equal "no" (if nil "yes" "no")) (assert-nil (if false "yes"))) - - (deftest "when" + (deftest + "when" (assert-equal "yes" (when true "yes")) (assert-nil (when false "yes"))) - - (deftest "cond" + (deftest + "cond" (assert-equal "a" (cond true "a" :else "b")) (assert-equal "b" (cond false "a" :else "b")) - (assert-equal "c" (cond - false "a" - false "b" - :else "c"))) - - (deftest "and" + (assert-equal "c" (cond false "a" false "b" :else "c"))) + (deftest + "and" (assert-true (and true true)) (assert-false (and true false)) (assert-false (and false true)) (assert-equal 3 (and 1 2 3))) - - (deftest "or" + (deftest + "or" (assert-equal 1 (or 1 2)) (assert-equal 2 (or false 2)) (assert-equal "fallback" (or nil false "fallback")) (assert-false (or false false))) - - (deftest "let" - (assert-equal 3 (let ((x 1) (y 2)) (+ x y))) - (assert-equal "hello world" + (deftest + "let" + (assert-equal + 3 + (let ((x 1) (y 2)) (+ x y))) + (assert-equal + "hello world" (let ((a "hello") (b " world")) (str a b)))) - - (deftest "let clojure-style" + (deftest + "let clojure-style" (assert-equal 3 (let (x 1 y 2) (+ x y)))) - - (deftest "do / begin" + (deftest + "do / begin" (assert-equal 3 (do 1 2 3)) (assert-equal "last" (begin "first" "middle" "last"))) - - (deftest "define" - (define x 42) - (assert-equal 42 x)) - - (deftest "set!" + (deftest "define" (define x 42) (assert-equal 42 x)) + (deftest + "set!" (define x 1) (set! x 2) (assert-equal 2 x))) - -;; -------------------------------------------------------------------------- -;; 3i. Lambda and closures -;; -------------------------------------------------------------------------- - -(defsuite "lambdas" - (deftest "basic lambda" - (let ((add (fn (a b) (+ a b)))) +(defsuite + "lambdas" + (deftest + "basic lambda" + (let + ((add (fn (a b) (+ a b)))) (assert-equal 3 (add 1 2)))) - - (deftest "closure captures env" - (let ((x 10)) - (let ((add-x (fn (y) (+ x y)))) + (deftest + "closure captures env" + (let + ((x 10)) + (let + ((add-x (fn (y) (+ x y)))) (assert-equal 15 (add-x 5))))) - - (deftest "lambda as argument" - (assert-equal (list 2 4 6) - (map (fn (x) (* x 2)) (list 1 2 3)))) - - (deftest "recursive lambda via define" - (define factorial - (fn (n) (if (<= n 1) 1 (* n (factorial (- n 1)))))) + (deftest + "lambda as argument" + (assert-equal + (list 2 4 6) + (map + (fn (x) (* x 2)) + (list 1 2 3)))) + (deftest + "recursive lambda via define" + (define + factorial + (fn + (n) + (if + (<= n 1) + 1 + (* n (factorial (- n 1)))))) (assert-equal 120 (factorial 5))) - - (deftest "higher-order returns lambda" - (let ((make-adder (fn (n) (fn (x) (+ n x))))) - (let ((add5 (make-adder 5))) + (deftest + "higher-order returns lambda" + (let + ((make-adder (fn (n) (fn (x) (+ n x))))) + (let + ((add5 (make-adder 5))) (assert-equal 8 (add5 3)))))) - -;; -------------------------------------------------------------------------- -;; 3j. Higher-order forms -;; -------------------------------------------------------------------------- - -(defsuite "higher-order" - (deftest "map" - (assert-equal (list 2 4 6) - (map (fn (x) (* x 2)) (list 1 2 3))) +(defsuite + "higher-order" + (deftest + "map" + (assert-equal + (list 2 4 6) + (map + (fn (x) (* x 2)) + (list 1 2 3))) (assert-equal (list) (map (fn (x) x) (list)))) - - (deftest "filter" - (assert-equal (list 2 4) - (filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4))) - (assert-equal (list) + (deftest + "filter" + (assert-equal + (list 2 4) + (filter + (fn (x) (= (mod x 2) 0)) + (list 1 2 3 4))) + (assert-equal + (list) (filter (fn (x) false) (list 1 2 3)))) - - (deftest "reduce" - (assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4))) - (assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))) - - (deftest "some" - (assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5))) - (assert-false (some (fn (x) (> x 10)) (list 1 2 3)))) - - (deftest "every?" - (assert-true (every? (fn (x) (> x 0)) (list 1 2 3))) - (assert-false (every? (fn (x) (> x 2)) (list 1 2 3)))) - - (deftest "map-indexed" - (assert-equal (list "0:a" "1:b" "2:c") + (deftest + "reduce" + (assert-equal + 10 + (reduce + (fn (acc x) (+ acc x)) + 0 + (list 1 2 3 4))) + (assert-equal + 0 + (reduce (fn (acc x) (+ acc x)) 0 (list)))) + (deftest + "some" + (assert-true + (some + (fn (x) (> x 3)) + (list 1 2 3 4 5))) + (assert-false + (some + (fn (x) (> x 10)) + (list 1 2 3)))) + (deftest + "every?" + (assert-true + (every? + (fn (x) (> x 0)) + (list 1 2 3))) + (assert-false + (every? + (fn (x) (> x 2)) + (list 1 2 3)))) + (deftest + "map-indexed" + (assert-equal + (list "0:a" "1:b" "2:c") (map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c"))))) - -;; -------------------------------------------------------------------------- -;; 3k. Components -;; -------------------------------------------------------------------------- - -(defsuite "components" - (deftest "defcomp creates component" - (defcomp ~test-comp (&key title) - (div title)) - ;; Component is bound and not nil +(defsuite + "components" + (deftest + "defcomp creates component" + (defcomp ~test-comp (&key title) (div title)) (assert-true (not (nil? ~test-comp)))) - - (deftest "component renders with keyword args" - (defcomp ~greeting (&key name) - (span (str "Hello, " name "!"))) + (deftest + "component renders with keyword args" + (defcomp ~greeting (&key name) (span (str "Hello, " name "!"))) (assert-true (not (nil? ~greeting)))) - - (deftest "component with children" - (defcomp ~box (&key &rest children) - (div :class "box" children)) + (deftest + "component with children" + (defcomp ~box (&key &rest children) (div :class "box" children)) (assert-true (not (nil? ~box)))) - - (deftest "component with default via or" - (defcomp ~label (&key text) - (span (or text "default"))) + (deftest + "component with default via or" + (defcomp ~label (&key text) (span (or text "default"))) (assert-true (not (nil? ~label))))) - -;; -------------------------------------------------------------------------- -;; 3l. Macros -;; -------------------------------------------------------------------------- - -(defsuite "macros" - (deftest "defmacro creates macro" - (defmacro unless (cond &rest body) - `(if (not ,cond) (do ,@body))) +(defsuite + "macros" + (deftest + "defmacro creates macro" + (defmacro + unless + (cond &rest body) + (quasiquote (if (not (unquote cond)) (do (splice-unquote body))))) (assert-equal "yes" (unless false "yes")) (assert-nil (unless true "no"))) + (deftest + "quasiquote and unquote" + (let + ((x 42)) + (assert-equal + (list 1 42 3) + (quasiquote (1 (unquote x) 3))))) + (deftest + "splice-unquote" + (let + ((xs (list 2 3 4))) + (assert-equal + (list 1 2 3 4 5) + (quasiquote (1 (splice-unquote xs) 5)))))) - (deftest "quasiquote and unquote" - (let ((x 42)) - (assert-equal (list 1 42 3) `(1 ,x 3)))) - - (deftest "splice-unquote" - (let ((xs (list 2 3 4))) - (assert-equal (list 1 2 3 4 5) `(1 ,@xs 5))))) - - -;; -------------------------------------------------------------------------- -;; 3m. Threading macro -;; -------------------------------------------------------------------------- - -(defsuite "threading" - (deftest "thread-first" +(defsuite + "threading" + (deftest + "thread-first" (assert-equal 8 (-> 5 (+ 1) (+ 2))) (assert-equal "HELLO" (-> "hello" upcase)) - (assert-equal "HELLO WORLD" - (-> "hello" - (str " world") - upcase)))) + (assert-equal "HELLO WORLD" (-> "hello" (str " world") upcase)))) - -;; -------------------------------------------------------------------------- -;; 3n. Truthiness -;; -------------------------------------------------------------------------- - -(defsuite "truthiness" - (deftest "truthy values" +(defsuite + "truthiness" + (deftest + "truthy values" (assert-true (if 1 true false)) (assert-true (if "x" true false)) (assert-true (if (list 1) true false)) (assert-true (if true true false))) - - (deftest "falsy values" + (deftest + "falsy values" (assert-false (if false true false)) - (assert-false (if nil true false))) + (assert-false (if nil true false)))) - ;; NOTE: empty list, zero, and empty string truthiness is - ;; platform-dependent. Python treats all three as falsy. - ;; JavaScript treats [] as truthy but 0 and "" as falsy. - ;; These tests are omitted — each bootstrapper should emit - ;; platform-specific truthiness tests instead. - ) - - -;; -------------------------------------------------------------------------- -;; 3o. Edge cases and regression tests -;; -------------------------------------------------------------------------- - -(defsuite "edge-cases" - (deftest "nested let scoping" - (let ((x 1)) - (let ((x 2)) - (assert-equal 2 x)) - ;; outer x should be unchanged by inner let - ;; (this tests that let creates a new scope) - )) - - (deftest "recursive map" - (assert-equal (list (list 2 4) (list 6 8)) - (map (fn (sub) (map (fn (x) (* x 2)) sub)) - (list (list 1 2) (list 3 4))))) - - (deftest "keyword as value" +(defsuite + "edge-cases" + (deftest + "nested let scoping" + (let + ((x 1)) + (let ((x 2)) (assert-equal 2 x)))) + (deftest + "recursive map" + (assert-equal + (list (list 2 4) (list 6 8)) + (map + (fn (sub) (map (fn (x) (* x 2)) sub)) + (list (list 1 2) (list 3 4))))) + (deftest + "keyword as value" (assert-equal "class" :class) (assert-equal "id" :id)) - - (deftest "dict with evaluated values" - (let ((x 42)) - (assert-equal 42 (get {:val x} "val")))) - - (deftest "nil propagation" + (deftest + "dict with evaluated values" + (let ((x 42)) (assert-equal 42 (get {:val x} "val")))) + (deftest + "nil propagation" (assert-nil (get {:a 1} "missing")) (assert-equal "default" (or (get {:a 1} "missing") "default"))) - - (deftest "empty operations" + (deftest + "empty operations" (assert-equal (list) (map (fn (x) x) (list))) (assert-equal (list) (filter (fn (x) true) (list))) - (assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))) + (assert-equal + 0 + (reduce (fn (acc x) (+ acc x)) 0 (list))) (assert-equal 0 (len (list))) (assert-equal "" (str))))