Compare commits

...

2 Commits

Author SHA1 Message Date
a40a970080 plan: tick Phase 18 sets — complete, Phase 19 next
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-01 18:46:01 +00:00
3b0ac67a10 spec: sets (make-set/set-add!/set-member?/union/intersection/etc)
Adds 13 set primitives to stdlib.sets. OCaml: SxSet as (string,value)
Hashtbl keyed by inspect(val); JS: SxSet wrapping Map keyed by
write-to-string. Structural equality — (make-set '(1 2)) contains 1.
Includes union, intersection, difference, for-each, map.
33 tests in test-sets.sx, all pass on both JS and OCaml.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-01 18:45:46 +00:00
7 changed files with 484 additions and 7 deletions

View File

@@ -1702,6 +1702,60 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
src.data.forEach(function(v, k) { dst.data.set(k, v); }); src.data.forEach(function(v, k) { dst.data.set(k, v); });
return null; return null;
}; };
''',
"stdlib.sets": '''
// stdlib.sets — structural sets keyed by write-to-string serialization
function SxSet() { this.data = new Map(); this._sxset = true; }
SxSet.prototype._type = "set";
function sxSetKey(v) { return sxWriteVal(v, "write"); }
function sxSetSeed(s, lst) {
if (Array.isArray(lst)) lst.forEach(function(v) { s.data.set(sxSetKey(v), v); });
return s;
}
PRIMITIVES["make-set"] = function() {
var s = new SxSet();
if (arguments.length > 0 && Array.isArray(arguments[0])) sxSetSeed(s, arguments[0]);
return s;
};
PRIMITIVES["set?"] = function(v) { return v instanceof SxSet; };
PRIMITIVES["set-add!"] = function(s, v) { s.data.set(sxSetKey(v), v); return NIL; };
PRIMITIVES["set-member?"] = function(s, v) { return s.data.has(sxSetKey(v)); };
PRIMITIVES["set-remove!"] = function(s, v) { s.data.delete(sxSetKey(v)); return NIL; };
PRIMITIVES["set-size"] = function(s) { return s.data.size; };
PRIMITIVES["set->list"] = function(s) { return Array.from(s.data.values()); };
PRIMITIVES["list->set"] = function(lst) {
var s = new SxSet();
if (Array.isArray(lst)) lst.forEach(function(v) { s.data.set(sxSetKey(v), v); });
return s;
};
PRIMITIVES["set-union"] = function(a, b) {
var s = new SxSet();
a.data.forEach(function(v, k) { s.data.set(k, v); });
b.data.forEach(function(v, k) { s.data.set(k, v); });
return s;
};
PRIMITIVES["set-intersection"] = function(a, b) {
var s = new SxSet();
a.data.forEach(function(v, k) { if (b.data.has(k)) s.data.set(k, v); });
return s;
};
PRIMITIVES["set-difference"] = function(a, b) {
var s = new SxSet();
a.data.forEach(function(v, k) { if (!b.data.has(k)) s.data.set(k, v); });
return s;
};
PRIMITIVES["set-for-each"] = function(s, fn) {
s.data.forEach(function(v) { apply(fn, [v]); });
return NIL;
};
PRIMITIVES["set-map"] = function(s, fn) {
var out = new SxSet();
s.data.forEach(function(v) {
var r = apply(fn, [v]);
out.data.set(sxSetKey(r), r);
});
return out;
};
''', ''',
} }
# Modules to include by default (all) # Modules to include by default (all)
@@ -1747,6 +1801,7 @@ PLATFORM_JS_PRE = '''
if (x._vector) return "vector"; if (x._vector) return "vector";
if (x._string_buffer) return "string-buffer"; if (x._string_buffer) return "string-buffer";
if (x._hash_table) return "hash-table"; if (x._hash_table) return "hash-table";
if (x._sxset) return "set";
if (x._rational) return "rational"; if (x._rational) return "rational";
if (typeof Node !== "undefined" && x instanceof Node) return "dom-node"; if (typeof Node !== "undefined" && x instanceof Node) return "dom-node";
if (Array.isArray(x)) return "list"; if (Array.isArray(x)) return "list";

View File

@@ -2687,4 +2687,87 @@ let () =
| _ -> raise (Eval_error "display-to-string: 1 arg")); | _ -> raise (Eval_error "display-to-string: 1 arg"));
register "current-input-port" (fun _ -> Nil); register "current-input-port" (fun _ -> Nil);
register "current-output-port" (fun _ -> Nil); register "current-output-port" (fun _ -> Nil);
register "current-error-port" (fun _ -> Nil) register "current-error-port" (fun _ -> Nil);
(* ---- Sets ---- *)
let set_key v = Sx_types.inspect v in
register "make-set" (fun args ->
let ht = Hashtbl.create 8 in
(match args with
| [] -> ()
| [List items] -> List.iter (fun v -> Hashtbl.replace ht (set_key v) v) items
| [ListRef r] -> List.iter (fun v -> Hashtbl.replace ht (set_key v) v) !r
| _ -> raise (Eval_error "make-set: expected optional list"));
SxSet ht);
register "set?" (fun args ->
match args with
| [SxSet _] -> Bool true
| [_] -> Bool false
| _ -> raise (Eval_error "set?: 1 arg"));
register "set-add!" (fun args ->
match args with
| [SxSet ht; v] -> Hashtbl.replace ht (set_key v) v; Nil
| _ -> raise (Eval_error "set-add!: expected set val"));
register "set-member?" (fun args ->
match args with
| [SxSet ht; v] -> Bool (Hashtbl.mem ht (set_key v))
| _ -> raise (Eval_error "set-member?: expected set val"));
register "set-remove!" (fun args ->
match args with
| [SxSet ht; v] -> Hashtbl.remove ht (set_key v); Nil
| _ -> raise (Eval_error "set-remove!: expected set val"));
register "set-size" (fun args ->
match args with
| [SxSet ht] -> Integer (Hashtbl.length ht)
| _ -> raise (Eval_error "set-size: expected set"));
register "set->list" (fun args ->
match args with
| [SxSet ht] -> List (Hashtbl.fold (fun _ v acc -> v :: acc) ht [])
| _ -> raise (Eval_error "set->list: expected set"));
register "list->set" (fun args ->
match args with
| [List items] ->
let ht = Hashtbl.create (List.length items) in
List.iter (fun v -> Hashtbl.replace ht (set_key v) v) items;
SxSet ht
| [ListRef r] ->
let ht = Hashtbl.create (List.length !r) in
List.iter (fun v -> Hashtbl.replace ht (set_key v) v) !r;
SxSet ht
| [Nil] -> SxSet (Hashtbl.create 0)
| _ -> raise (Eval_error "list->set: expected list"));
register "set-union" (fun args ->
match args with
| [SxSet a; SxSet b] ->
let ht = Hashtbl.copy a in
Hashtbl.iter (fun k v -> Hashtbl.replace ht k v) b;
SxSet ht
| _ -> raise (Eval_error "set-union: expected 2 sets"));
register "set-intersection" (fun args ->
match args with
| [SxSet a; SxSet b] ->
let ht = Hashtbl.create 8 in
Hashtbl.iter (fun k v -> if Hashtbl.mem b k then Hashtbl.replace ht k v) a;
SxSet ht
| _ -> raise (Eval_error "set-intersection: expected 2 sets"));
register "set-difference" (fun args ->
match args with
| [SxSet a; SxSet b] ->
let ht = Hashtbl.create 8 in
Hashtbl.iter (fun k v -> if not (Hashtbl.mem b k) then Hashtbl.replace ht k v) a;
SxSet ht
| _ -> raise (Eval_error "set-difference: expected 2 sets"));
register "set-for-each" (fun args ->
match args with
| [SxSet ht; fn] ->
Hashtbl.iter (fun _ v -> ignore (!Sx_types._cek_call_ref fn (List [v]))) ht;
Nil
| _ -> raise (Eval_error "set-for-each: expected set fn"));
register "set-map" (fun args ->
match args with
| [SxSet ht; fn] ->
let out = Hashtbl.create (Hashtbl.length ht) in
Hashtbl.iter (fun _ v ->
let r = !Sx_types._cek_call_ref fn (List [v]) in
Hashtbl.replace out (set_key r) r) ht;
SxSet out
| _ -> raise (Eval_error "set-map: expected set fn"))

View File

@@ -79,6 +79,7 @@ and value =
| Eof (** EOF sentinel — returned by read-char etc. at end of input. *) | Eof (** EOF sentinel — returned by read-char etc. at end of input. *)
| Port of sx_port (** String port — input (string cursor) or output (buffer). *) | Port of sx_port (** String port — input (string cursor) or output (buffer). *)
| Rational of int * int (** Exact rational: numerator, denominator (reduced, denom>0). *) | Rational of int * int (** Exact rational: numerator, denominator (reduced, denom>0). *)
| SxSet of (string, value) Hashtbl.t (** Mutable set keyed by inspect(value). *)
(** String input port: source string + mutable cursor position. *) (** String input port: source string + mutable cursor position. *)
and sx_port_kind = and sx_port_kind =
@@ -514,6 +515,7 @@ let type_of = function
| Port { sp_kind = PortInput _; _ } -> "input-port" | Port { sp_kind = PortInput _; _ } -> "input-port"
| Port { sp_kind = PortOutput _; _ } -> "output-port" | Port { sp_kind = PortOutput _; _ } -> "output-port"
| Rational _ -> "rational" | Rational _ -> "rational"
| SxSet _ -> "set"
let is_nil = function Nil -> true | _ -> false let is_nil = function Nil -> true | _ -> false
let is_lambda = function Lambda _ -> true | _ -> false let is_lambda = function Lambda _ -> true | _ -> false
@@ -876,3 +878,4 @@ let rec inspect = function
| Port { sp_kind = PortOutput buf; sp_closed } -> | Port { sp_kind = PortOutput buf; sp_closed } ->
Printf.sprintf "<output-port:len=%d%s>" (Buffer.length buf) (if sp_closed then ":closed" else "") 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 | Rational (n, d) -> Printf.sprintf "%d/%d" n d
| SxSet ht -> Printf.sprintf "<set:%d>" (Hashtbl.length ht)

View File

@@ -556,13 +556,13 @@ Primitives to add:
- `set-map` `s` `fn` → new set of mapped values - `set-map` `s` `fn` → new set of mapped values
Steps: Steps:
- [ ] Spec: add entries to `spec/primitives.sx`. - [x] Spec: add entries to `spec/primitives.sx`.
- [ ] OCaml: implement using `Hashtbl.t` with unit values (or a proper `Set` functor - [x] OCaml: implement using `Hashtbl.t` with unit values (or a proper `Set` functor
with a comparison function); add `SxSet` to `sx_types.ml`. with a comparison function); add `SxSet` to `sx_types.ml`.
- [ ] JS bootstrapper: implement using JS `Set`. - [x] JS bootstrapper: implement using JS `Set`.
- [ ] Tests: 30+ tests in `spec/tests/test-sets.sx` — add/member/remove, union/intersection/ - [x] Tests: 30+ tests in `spec/tests/test-sets.sx` — add/member/remove, union/intersection/
difference, list conversion, for-each, size. difference, list conversion, for-each, size.
- [ ] Commit: `spec: sets (make-set/set-add!/set-member?/union/intersection/etc)` - [x] Commit: `spec: sets (make-set/set-add!/set-member?/union/intersection/etc)`
--- ---
@@ -751,6 +751,7 @@ _Newest first._
- 2026-04-25: Phase 1 spec step done — all 10 vector primitives in spec/primitives.sx have full :as type annotations, :returns, :doc; make-vector optional fill param added. - 2026-04-25: Phase 1 spec step done — all 10 vector primitives in spec/primitives.sx have full :as type annotations, :returns, :doc; make-vector optional fill param added.
- 2026-04-25: Phase 1 OCaml step done — bounds-checked vector-ref/set!, vector-copy now accepts optional start/end, spec/primitives.sx doc updated. 10/10 r7rs vector tests pass, 4747 total (394 pre-existing hs-upstream fails unchanged). - 2026-04-25: Phase 1 OCaml step done — bounds-checked vector-ref/set!, vector-copy now accepts optional start/end, spec/primitives.sx doc updated. 10/10 r7rs vector tests pass, 4747 total (394 pre-existing hs-upstream fails unchanged).
- 2026-04-25: Phase 0 complete — stopped CL/APL/Ruby/Tcl loops (all 4 idle at shell); confirmed E38 (tokenizer :end/:line) and E39 (WebWorker stub) both have implementation commits. - 2026-04-25: Phase 0 complete — stopped CL/APL/Ruby/Tcl loops (all 4 idle at shell); confirmed E38 (tokenizer :end/:line) and E39 (WebWorker stub) both have implementation commits.
- 2026-05-01: Phase 18 complete — sets. SxSet as (string,value) Hashtbl keyed by inspect(val) in OCaml; Map keyed by write-to-string in JS. 13 primitives: make-set, set?, set-add!, set-member?, set-remove!, set-size, set->list, list->set, set-union, set-intersection, set-difference, set-for-each, set-map. 33 tests, all pass. JS 2469, OCaml 4659. 3b0ac67a.
- 2026-05-01: Phase 17 complete — read/write/display. OCaml: sx_write_val/sx_display_val helpers; read via Sx_parser.read_value with #t/#f and N/D rational support added to parser; postprocess ()→Nil. JS: sxReadNormalize (#t/#f→true/false), sxReadConvert (()→NIL), sxEq list equality, sxWriteVal symbol/keyword name fix (v.name not v._sym), readerMacroGet registry. 42 tests (test-read-write.sx), all pass both hosts. JS 2436, OCaml 4626. 7d329f02. - 2026-05-01: Phase 17 complete — read/write/display. OCaml: sx_write_val/sx_display_val helpers; read via Sx_parser.read_value with #t/#f and N/D rational support added to parser; postprocess ()→Nil. JS: sxReadNormalize (#t/#f→true/false), sxReadConvert (()→NIL), sxEq list equality, sxWriteVal symbol/keyword name fix (v.name not v._sym), readerMacroGet registry. 42 tests (test-read-write.sx), all pass both hosts. JS 2436, OCaml 4626. 7d329f02.
- 2026-05-01: Phase 16 complete — rational numbers. SxRational type in OCaml (Rational of int*int, reduced, denom>0) and JS (SxRational class, _rational marker). n/d reader in spec/parser.sx. Arithmetic contagion: int op rational → rational, rational op float → float. JS keeps int/int → float for CSS compat. OCaml as_number+safe_eq extended for cross-type rational equality. 62 tests in test-rationals.sx, all pass. JS 2232, OCaml 4532 (+11). 036022cc. - 2026-05-01: Phase 16 complete — rational numbers. SxRational type in OCaml (Rational of int*int, reduced, denom>0) and JS (SxRational class, _rational marker). n/d reader in spec/parser.sx. Arithmetic contagion: int op rational → rational, rational op float → float. JS keeps int/int → float for CSS compat. OCaml as_number+safe_eq extended for cross-type rational equality. 62 tests in test-rationals.sx, all pass. JS 2232, OCaml 4532 (+11). 036022cc.
- 2026-05-01: Phase 15 complete — math completeness. stdlib.math module: sin/cos/tan/asin/acos/atan(1-2 args)/exp/log/expt/quotient/gcd/lcm/number->string(radix)/string->number(radix). OCaml atan updated for optional 2nd arg. Strict radix parsing in JS string->number. 44 tests in test-math.sx, all pass. JS 2311/4801, OCaml 4547/5629. be2b11ac. - 2026-05-01: Phase 15 complete — math completeness. stdlib.math module: sin/cos/tan/asin/acos/atan(1-2 args)/exp/log/expt/quotient/gcd/lcm/number->string(radix)/string->number(radix). OCaml atan updated for optional 2nd arg. Strict radix parsing in JS string->number. 44 tests in test-math.sx, all pass. JS 2311/4801, OCaml 4547/5629. be2b11ac.

View File

@@ -41,7 +41,7 @@
// ========================================================================= // =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-05-01T18:13:58Z"; var SX_VERSION = "2026-05-01T18:42:40Z";
function isNil(x) { return x === NIL || x === null || x === undefined; } function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); } function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -184,6 +184,7 @@
if (x._vector) return "vector"; if (x._vector) return "vector";
if (x._string_buffer) return "string-buffer"; if (x._string_buffer) return "string-buffer";
if (x._hash_table) return "hash-table"; if (x._hash_table) return "hash-table";
if (x._sxset) return "set";
if (x._rational) return "rational"; if (x._rational) return "rational";
if (typeof Node !== "undefined" && x instanceof Node) return "dom-node"; if (typeof Node !== "undefined" && x instanceof Node) return "dom-node";
if (Array.isArray(x)) return "list"; if (Array.isArray(x)) return "list";
@@ -1096,6 +1097,60 @@
}; };
// stdlib.sets — structural sets keyed by write-to-string serialization
function SxSet() { this.data = new Map(); this._sxset = true; }
SxSet.prototype._type = "set";
function sxSetKey(v) { return sxWriteVal(v, "write"); }
function sxSetSeed(s, lst) {
if (Array.isArray(lst)) lst.forEach(function(v) { s.data.set(sxSetKey(v), v); });
return s;
}
PRIMITIVES["make-set"] = function() {
var s = new SxSet();
if (arguments.length > 0 && Array.isArray(arguments[0])) sxSetSeed(s, arguments[0]);
return s;
};
PRIMITIVES["set?"] = function(v) { return v instanceof SxSet; };
PRIMITIVES["set-add!"] = function(s, v) { s.data.set(sxSetKey(v), v); return NIL; };
PRIMITIVES["set-member?"] = function(s, v) { return s.data.has(sxSetKey(v)); };
PRIMITIVES["set-remove!"] = function(s, v) { s.data.delete(sxSetKey(v)); return NIL; };
PRIMITIVES["set-size"] = function(s) { return s.data.size; };
PRIMITIVES["set->list"] = function(s) { return Array.from(s.data.values()); };
PRIMITIVES["list->set"] = function(lst) {
var s = new SxSet();
if (Array.isArray(lst)) lst.forEach(function(v) { s.data.set(sxSetKey(v), v); });
return s;
};
PRIMITIVES["set-union"] = function(a, b) {
var s = new SxSet();
a.data.forEach(function(v, k) { s.data.set(k, v); });
b.data.forEach(function(v, k) { s.data.set(k, v); });
return s;
};
PRIMITIVES["set-intersection"] = function(a, b) {
var s = new SxSet();
a.data.forEach(function(v, k) { if (b.data.has(k)) s.data.set(k, v); });
return s;
};
PRIMITIVES["set-difference"] = function(a, b) {
var s = new SxSet();
a.data.forEach(function(v, k) { if (!b.data.has(k)) s.data.set(k, v); });
return s;
};
PRIMITIVES["set-for-each"] = function(s, fn) {
s.data.forEach(function(v) { apply(fn, [v]); });
return NIL;
};
PRIMITIVES["set-map"] = function(s, fn) {
var out = new SxSet();
s.data.forEach(function(v) {
var r = apply(fn, [v]);
out.data.set(sxSetKey(r), r);
});
return out;
};
function isPrimitive(name) { return name in PRIMITIVES; } function isPrimitive(name) { return name in PRIMITIVES; }
function getPrimitive(name) { return PRIMITIVES[name]; } function getPrimitive(name) { return PRIMITIVES[name]; }

View File

@@ -1116,3 +1116,83 @@
:doc "Denominator of rational r (after reduction, always positive).") :doc "Denominator of rational r (after reduction, always positive).")
(define-module :stdlib.hash-table) (define-module :stdlib.hash-table)
(define-module :stdlib.sets)
(define-primitive
"make-set"
:params (&rest (lst :as list))
:returns "set"
:doc "Create a fresh empty set. Optional list argument seeds the set: (make-set '(1 2 3)).")
(define-primitive
"set?"
:params (v)
:returns "boolean"
:doc "True if v is a set.")
(define-primitive
"set-add!"
:params (s val)
:returns "nil"
:doc "Add val to set s in place. No-op if already present.")
(define-primitive
"set-member?"
:params (s val)
:returns "boolean"
:doc "True if val is in set s.")
(define-primitive
"set-remove!"
:params (s val)
:returns "nil"
:doc "Remove val from set s in place. No-op if absent.")
(define-primitive
"set-size"
:params (s)
:returns "integer"
:doc "Number of elements in set s.")
(define-primitive
"set->list"
:params (s)
:returns "list"
:doc "All elements of set s as a list (unspecified order).")
(define-primitive
"list->set"
:params (lst)
:returns "set"
:doc "Create a new set containing all elements of lst.")
(define-primitive
"set-union"
:params (s1 s2)
:returns "set"
:doc "New set with all elements from s1 and s2.")
(define-primitive
"set-intersection"
:params (s1 s2)
:returns "set"
:doc "New set with elements present in both s1 and s2.")
(define-primitive
"set-difference"
:params (s1 s2)
:returns "set"
:doc "New set with elements in s1 that are not in s2.")
(define-primitive
"set-for-each"
:params (s fn)
:returns "nil"
:doc "Call (fn val) for each element in set s. Order unspecified.")
(define-primitive
"set-map"
:params (s fn)
:returns "set"
:doc "New set of results of (fn val) for each element in s.")

200
spec/tests/test-sets.sx Normal file
View File

@@ -0,0 +1,200 @@
;; ==========================================================================
;; test-sets.sx — Tests for set primitives
;; ==========================================================================
;; --------------------------------------------------------------------------
;; make-set / set?
;; --------------------------------------------------------------------------
(defsuite
"sets:create"
(deftest "make-set returns a set" (assert (set? (make-set))))
(deftest "empty set has size 0" (assert= (set-size (make-set)) 0))
(deftest
"make-set from list"
(let ((s (make-set (list 1 2 3)))) (assert= (set-size s) 3)))
(deftest
"make-set deduplicates"
(let ((s (make-set (list 1 2 2 3 3)))) (assert= (set-size s) 3)))
(deftest "set? true for sets" (assert (set? (make-set))))
(deftest "set? false for list" (assert (not (set? (list 1 2 3)))))
(deftest "set? false for nil" (assert (not (set? nil))))
(deftest "set? false for number" (assert (not (set? 42)))))
;; --------------------------------------------------------------------------
;; set-add! / set-member? / set-remove!
;; --------------------------------------------------------------------------
(defsuite
"sets:mutation"
(deftest
"set-add! increases size"
(let
((s (make-set)))
(set-add! s 1)
(assert= (set-size s) 1)))
(deftest
"set-add! idempotent"
(let
((s (make-set)))
(set-add! s 1)
(set-add! s 1)
(assert= (set-size s) 1)))
(deftest
"set-member? true after add"
(let
((s (make-set)))
(set-add! s "hello")
(assert (set-member? s "hello"))))
(deftest
"set-member? false for absent"
(let
((s (make-set (list 1 2 3))))
(assert (not (set-member? s 99)))))
(deftest
"set-remove! reduces size"
(let
((s (make-set (list 1 2 3))))
(set-remove! s 2)
(assert= (set-size s) 2)))
(deftest
"set-remove! removes element"
(let
((s (make-set (list 1 2 3))))
(set-remove! s 2)
(assert (not (set-member? s 2)))))
(deftest
"set-remove! no-op for absent"
(let
((s (make-set (list 1 2 3))))
(set-remove! s 99)
(assert= (set-size s) 3)))
(deftest
"set handles strings"
(let
((s (make-set)))
(set-add! s "a")
(set-add! s "b")
(assert (and (set-member? s "a") (set-member? s "b")))))
(deftest
"set handles symbols"
(let
((s (make-set)))
(set-add! s (quote foo))
(assert (set-member? s (quote foo))))))
;; --------------------------------------------------------------------------
;; set->list / list->set
;; --------------------------------------------------------------------------
(defsuite
"sets:conversion"
(deftest
"list->set creates set"
(let ((s (list->set (list 1 2 3)))) (assert (set? s))))
(deftest
"list->set size"
(let ((s (list->set (list 1 2 3)))) (assert= (set-size s) 3)))
(deftest
"list->set deduplicates"
(let ((s (list->set (list 1 1 2)))) (assert= (set-size s) 2)))
(deftest
"set->list has all elements"
(let
((s (make-set (list 1 2 3)))
(lst (set->list s)))
(assert= (length lst) 3)))
(deftest
"set->list round-trip membership"
(let
((s (make-set (list 10 20 30)))
(lst (set->list s)))
(assert
(and
(set-member? (list->set lst) 10)
(set-member? (list->set lst) 20)
(set-member? (list->set lst) 30))))))
;; --------------------------------------------------------------------------
;; set-union / set-intersection / set-difference
;; --------------------------------------------------------------------------
(defsuite
"sets:operations"
(deftest
"union size"
(let
((a (make-set (list 1 2 3)))
(b (make-set (list 3 4 5))))
(assert= (set-size (set-union a b)) 5)))
(deftest
"union contains all"
(let
((u (set-union (make-set (list 1 2)) (make-set (list 3 4)))))
(assert
(and
(set-member? u 1)
(set-member? u 3)
(set-member? u 4)))))
(deftest
"intersection size"
(let
((a (make-set (list 1 2 3)))
(b (make-set (list 2 3 4))))
(assert= (set-size (set-intersection a b)) 2)))
(deftest
"intersection contains overlap"
(let
((i (set-intersection (make-set (list 1 2 3)) (make-set (list 2 3 4)))))
(assert (and (set-member? i 2) (set-member? i 3) (not (set-member? i 1))))))
(deftest
"intersection empty when disjoint"
(let
((a (make-set (list 1 2)))
(b (make-set (list 3 4))))
(assert= (set-size (set-intersection a b)) 0)))
(deftest
"difference size"
(let
((a (make-set (list 1 2 3)))
(b (make-set (list 2 3))))
(assert= (set-size (set-difference a b)) 1)))
(deftest
"difference keeps only a-exclusive"
(let
((d (set-difference (make-set (list 1 2 3)) (make-set (list 2 3 4)))))
(assert (and (set-member? d 1) (not (set-member? d 2)) (not (set-member? d 4))))))
(deftest
"union does not mutate inputs"
(let
((a (make-set (list 1 2)))
(b (make-set (list 3 4))))
(set-union a b)
(assert= (set-size a) 2))))
;; --------------------------------------------------------------------------
;; set-for-each / set-map
;; --------------------------------------------------------------------------
(defsuite
"sets:higher-order"
(deftest
"set-for-each visits all"
(let
((s (make-set (list 1 2 3)))
(acc (list)))
(set-for-each s (fn (v) (set! acc (cons v acc))))
(assert= (length acc) 3)))
(deftest
"set-map doubles values"
(let
((s (make-set (list 1 2 3)))
(s2 (set-map s (fn (v) (* v 2)))))
(assert
(and
(set-member? s2 2)
(set-member? s2 4)
(set-member? s2 6)))))
(deftest
"set-map result is a set"
(assert (set? (set-map (make-set (list 1 2)) (fn (v) v))))))