diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index cfec88e3..8a3bb406 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -1702,6 +1702,60 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { src.data.forEach(function(v, k) { dst.data.set(k, v); }); 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) @@ -1747,6 +1801,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._sxset) return "set"; if (x._rational) return "rational"; if (typeof Node !== "undefined" && x instanceof Node) return "dom-node"; if (Array.isArray(x)) return "list"; diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index e0ba4d37..b7d8dfea 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -2687,4 +2687,87 @@ let () = | _ -> raise (Eval_error "display-to-string: 1 arg")); register "current-input-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")) diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index df3c1070..5f4f3ccd 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -79,6 +79,7 @@ and value = | 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). *) + | SxSet of (string, value) Hashtbl.t (** Mutable set keyed by inspect(value). *) (** String input port: source string + mutable cursor position. *) and sx_port_kind = @@ -514,6 +515,7 @@ let type_of = function | Port { sp_kind = PortInput _; _ } -> "input-port" | Port { sp_kind = PortOutput _; _ } -> "output-port" | Rational _ -> "rational" + | SxSet _ -> "set" let is_nil = function Nil -> true | _ -> false let is_lambda = function Lambda _ -> true | _ -> false @@ -876,3 +878,4 @@ let rec inspect = function | Port { sp_kind = PortOutput buf; sp_closed } -> Printf.sprintf "" (Buffer.length buf) (if sp_closed then ":closed" else "") | Rational (n, d) -> Printf.sprintf "%d/%d" n d + | SxSet ht -> Printf.sprintf "" (Hashtbl.length ht) diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index 222e7065..40929353 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -41,7 +41,7 @@ // ========================================================================= 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 isSxTruthy(x) { return x !== false && !isNil(x); } @@ -184,6 +184,7 @@ if (x._vector) return "vector"; if (x._string_buffer) return "string-buffer"; if (x._hash_table) return "hash-table"; + if (x._sxset) return "set"; if (x._rational) return "rational"; if (typeof Node !== "undefined" && x instanceof Node) return "dom-node"; 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 getPrimitive(name) { return PRIMITIVES[name]; } diff --git a/spec/primitives.sx b/spec/primitives.sx index 8122565f..698396b6 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -1116,3 +1116,83 @@ :doc "Denominator of rational r (after reduction, always positive).") (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.") diff --git a/spec/tests/test-sets.sx b/spec/tests/test-sets.sx new file mode 100644 index 00000000..d4e3bd7c --- /dev/null +++ b/spec/tests/test-sets.sx @@ -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))))))