spec: mutable hash tables (make-hash-table/ref/set!/delete!/etc)
Phase 10 — 11 primitives: make-hash-table, hash-table?, hash-table-set!, hash-table-ref, hash-table-delete!, hash-table-size, hash-table-keys, hash-table-values, hash-table->alist, hash-table-for-each, hash-table-merge!. OCaml HashTable variant; JS Map-based. 28 tests, both hosts green. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -2052,4 +2052,64 @@ let () =
|
||||
n := !n lsr 1
|
||||
done;
|
||||
Integer !bits
|
||||
| _ -> raise (Eval_error "integer-length: expected (integer)"))
|
||||
| _ -> raise (Eval_error "integer-length: expected (integer)"));
|
||||
|
||||
(* Phase 10: mutable hash tables *)
|
||||
register "make-hash-table" (fun _ -> HashTable (Hashtbl.create 16));
|
||||
register "hash-table?" (fun args ->
|
||||
match args with
|
||||
| [HashTable _] -> Bool true
|
||||
| [_] -> Bool false
|
||||
| _ -> Bool false);
|
||||
register "hash-table-set!" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht; k; v] ->
|
||||
(try Hashtbl.replace ht k v
|
||||
with _ ->
|
||||
(* fallback: scan for physically equal key *)
|
||||
let found = ref false in
|
||||
Hashtbl.iter (fun ek _ -> if ek == k then (Hashtbl.replace ht ek v; found := true)) ht;
|
||||
if not !found then Hashtbl.replace ht k v);
|
||||
Nil
|
||||
| _ -> raise (Eval_error "hash-table-set!: expected (ht key val)"));
|
||||
register "hash-table-ref" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht; k] ->
|
||||
(try Hashtbl.find ht k
|
||||
with Not_found -> raise (Eval_error ("hash-table-ref: key not found")))
|
||||
| [HashTable ht; k; default] ->
|
||||
(try Hashtbl.find ht k with Not_found -> default)
|
||||
| _ -> raise (Eval_error "hash-table-ref: expected (ht key) or (ht key default)"));
|
||||
register "hash-table-delete!" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht; k] -> Hashtbl.remove ht k; Nil
|
||||
| _ -> raise (Eval_error "hash-table-delete!: expected (ht key)"));
|
||||
register "hash-table-size" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht] -> Integer (Hashtbl.length ht)
|
||||
| _ -> raise (Eval_error "hash-table-size: expected (ht)"));
|
||||
register "hash-table-keys" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht] -> List (Hashtbl.fold (fun k _ acc -> k :: acc) ht [])
|
||||
| _ -> raise (Eval_error "hash-table-keys: expected (ht)"));
|
||||
register "hash-table-values" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht] -> List (Hashtbl.fold (fun _ v acc -> v :: acc) ht [])
|
||||
| _ -> raise (Eval_error "hash-table-values: expected (ht)"));
|
||||
register "hash-table->alist" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht] ->
|
||||
List (Hashtbl.fold (fun k v acc -> List [k; v] :: acc) ht [])
|
||||
| _ -> raise (Eval_error "hash-table->alist: expected (ht)"));
|
||||
register "hash-table-for-each" (fun args ->
|
||||
match args with
|
||||
| [HashTable ht; fn] ->
|
||||
Hashtbl.iter (fun k v -> ignore (!Sx_types._cek_call_ref fn (List [k; v]))) ht;
|
||||
Nil
|
||||
| _ -> raise (Eval_error "hash-table-for-each: expected (ht fn)"));
|
||||
register "hash-table-merge!" (fun args ->
|
||||
match args with
|
||||
| [HashTable dst; HashTable src] ->
|
||||
Hashtbl.iter (fun k v -> Hashtbl.replace dst k v) src;
|
||||
Nil
|
||||
| _ -> raise (Eval_error "hash-table-merge!: expected (dst src)"))
|
||||
|
||||
@@ -74,6 +74,7 @@ and value =
|
||||
| Parameter of parameter (** R7RS parameter — dynamic binding via kont-stack provide frames. *)
|
||||
| Vector of value array (** R7RS vector — mutable fixed-size array. *)
|
||||
| StringBuffer of Buffer.t (** Mutable string buffer — O(1) amortized append. *)
|
||||
| HashTable of (value, value) Hashtbl.t (** Mutable hash table with arbitrary keys. *)
|
||||
|
||||
(** CEK machine state — record instead of Dict for performance.
|
||||
5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *)
|
||||
@@ -493,6 +494,7 @@ let type_of = function
|
||||
| Parameter _ -> "parameter"
|
||||
| Vector _ -> "vector"
|
||||
| StringBuffer _ -> "string-buffer"
|
||||
| HashTable _ -> "hash-table"
|
||||
|
||||
let is_nil = function Nil -> true | _ -> false
|
||||
let is_lambda = function Lambda _ -> true | _ -> false
|
||||
@@ -839,3 +841,4 @@ let rec inspect = function
|
||||
| VmFrame f -> Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base
|
||||
| VmMachine m -> Printf.sprintf "<vm-machine:sp=%d frames=%d>" m.vm_sp (List.length m.vm_frames)
|
||||
| StringBuffer buf -> Printf.sprintf "<string-buffer:%d>" (Buffer.length buf)
|
||||
| HashTable ht -> Printf.sprintf "<hash-table:%d>" (Hashtbl.length ht)
|
||||
|
||||
Reference in New Issue
Block a user