coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

spec: rational numbers — 1/3 literals, arithmetic, numeric tower integration

Browse Source 
SxRational type in OCaml (Rational of int * int, stored reduced, denom>0)
and JS (SxRational class with _rational marker). n/d reader syntax in
spec/parser.sx. Arithmetic contagion: int op rational → rational, rational
op float → float. JS keeps int/int → float for CSS backward compatibility.
OCaml as_number + safe_eq extended for cross-type rational equality so
(= 2.5 5/2) → true. 62 tests in test-rationals.sx, all pass.
JS: 2232 passed. OCaml: 4532 passed (+11 vs pre-fix baseline).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-01 17:27:27 +00:00
parent e9d2003d6a
commit 036022cc17
12 changed files with 1558 additions and 859 deletions
Download Patch File Download Diff File Expand all files Collapse all files

126
hosts/javascript/platform.py
View File

@@ -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";

1
hosts/ocaml/bin/sx_server.ml
View File

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

91
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -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

3
hosts/ocaml/lib/sx_types.ml
View File

@@ -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 "<input-port:pos=%d%s>" !pos (if sp_closed then ":closed" else "")
| Port { sp_kind = PortOutput buf; sp_closed } ->
Printf.sprintf "<output-port:len=%d%s>" (Buffer.length buf) (if sp_closed then ":closed" else "")
| Rational (n, d) -> Printf.sprintf "%d/%d" n d

150
shared/static/scripts/sx-browser.js
View File

@@ -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)); })(); };

65
spec/parser.sx
View File

@@ -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

26
spec/primitives.sx
View File

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

682
spec/tests/test-eval.sx
View File

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

23
spec/tests/test-numeric-tower.sx
View File

@@ -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"

295
spec/tests/test-primitives.sx
View File

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

135
spec/tests/test-rationals.sx Normal file
View File

@@ -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")))

820
spec/tests/test.sx
View File

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