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>
This commit is contained in:
@@ -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"))
|
||||
|
||||
@@ -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 "<output-port:len=%d%s>" (Buffer.length buf) (if sp_closed then ":closed" else "")
|
||||
| Rational (n, d) -> Printf.sprintf "%d/%d" n d
|
||||
| SxSet ht -> Printf.sprintf "<set:%d>" (Hashtbl.length ht)
|
||||
|
||||
Reference in New Issue
Block a user