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:
2026-05-01 08:48:41 +00:00
parent 2e4502878f
commit 133bdf5295
5 changed files with 264 additions and 2 deletions

View File

@@ -1030,7 +1030,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
PRIMITIVES["inexact?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); }; PRIMITIVES["inexact?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); };
PRIMITIVES["string?"] = function(x) { return typeof x === "string"; }; PRIMITIVES["string?"] = function(x) { return typeof x === "string"; };
PRIMITIVES["list?"] = Array.isArray; 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; }; 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["empty?"] = function(c) { return isNil(c) || (Array.isArray(c) ? c.length === 0 : typeof c === "string" ? c.length === 0 : Object.keys(c).length === 0); }; 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) { PRIMITIVES["contains?"] = function(c, k) {
if (typeof c === "string") return c.indexOf(String(k)) !== -1; if (typeof c === "string") return c.indexOf(String(k)) !== -1;
@@ -1329,6 +1329,35 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
if (a === 0) return 0; if (a === 0) return 0;
return 32 - Math.clz32(Math.abs(a)); return 32 - Math.clz32(Math.abs(a));
}; };
''',
"stdlib.hash-table": '''
// stdlib.hash-table
function SxHashTable() { this.data = new Map(); this._hash_table = true; }
PRIMITIVES["make-hash-table"] = function() { return new SxHashTable(); };
PRIMITIVES["hash-table?"] = function(x) { return x instanceof SxHashTable; };
PRIMITIVES["hash-table-set!"] = function(ht, k, v) { ht.data.set(k, v); return null; };
PRIMITIVES["hash-table-ref"] = function(ht, k, dflt) {
if (ht.data.has(k)) return ht.data.get(k);
if (arguments.length > 2) return dflt;
throw new Error("hash-table-ref: key not found");
};
PRIMITIVES["hash-table-delete!"] = function(ht, k) { ht.data.delete(k); return null; };
PRIMITIVES["hash-table-size"] = function(ht) { return ht.data.size; };
PRIMITIVES["hash-table-keys"] = function(ht) { return Array.from(ht.data.keys()); };
PRIMITIVES["hash-table-values"] = function(ht) { return Array.from(ht.data.values()); };
PRIMITIVES["hash-table->alist"] = function(ht) {
var result = [];
ht.data.forEach(function(v, k) { result.push([k, v]); });
return result;
};
PRIMITIVES["hash-table-for-each"] = function(ht, fn) {
ht.data.forEach(function(v, k) { apply(fn, [k, v]); });
return null;
};
PRIMITIVES["hash-table-merge!"] = function(dst, src) {
src.data.forEach(function(v, k) { dst.data.set(k, v); });
return null;
};
''', ''',
} }
# Modules to include by default (all) # Modules to include by default (all)
@@ -1370,6 +1399,7 @@ PLATFORM_JS_PRE = '''
if (x._sx_expr) return "sx-expr"; if (x._sx_expr) return "sx-expr";
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 (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";
if (typeof x === "object") return "dict"; if (typeof x === "object") return "dict";
@@ -1633,6 +1663,7 @@ PLATFORM_JS_POST = '''
if (isLambda(f)) return trampoline(callLambda(f, args, lambdaClosure(f))); if (isLambda(f)) return trampoline(callLambda(f, args, lambdaClosure(f)));
return f.apply(null, args); return f.apply(null, args);
}; };
PRIMITIVES["apply"] = apply;
// Additional primitive aliases used by adapter/engine transpiled code // Additional primitive aliases used by adapter/engine transpiled code
var split = PRIMITIVES["split"]; var split = PRIMITIVES["split"];

View File

@@ -2052,4 +2052,64 @@ let () =
n := !n lsr 1 n := !n lsr 1
done; done;
Integer !bits 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)"))

View File

@@ -74,6 +74,7 @@ and value =
| Parameter of parameter (** R7RS parameter — dynamic binding via kont-stack provide frames. *) | Parameter of parameter (** R7RS parameter — dynamic binding via kont-stack provide frames. *)
| Vector of value array (** R7RS vector — mutable fixed-size array. *) | Vector of value array (** R7RS vector — mutable fixed-size array. *)
| StringBuffer of Buffer.t (** Mutable string buffer — O(1) amortized append. *) | 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. (** CEK machine state — record instead of Dict for performance.
5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *) 5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *)
@@ -493,6 +494,7 @@ let type_of = function
| Parameter _ -> "parameter" | Parameter _ -> "parameter"
| Vector _ -> "vector" | Vector _ -> "vector"
| StringBuffer _ -> "string-buffer" | StringBuffer _ -> "string-buffer"
| HashTable _ -> "hash-table"
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
@@ -839,3 +841,4 @@ let rec inspect = function
| VmFrame f -> Printf.sprintf "<vm-frame:ip=%d base=%d>" f.vf_ip f.vf_base | 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) | 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) | StringBuffer buf -> Printf.sprintf "<string-buffer:%d>" (Buffer.length buf)
| HashTable ht -> Printf.sprintf "<hash-table:%d>" (Hashtbl.length ht)

View File

@@ -849,3 +849,5 @@
:params ((a :as number)) :params ((a :as number))
:returns "number" :returns "number"
:doc "Number of bits needed to represent integer a (excluding sign).") :doc "Number of bits needed to represent integer a (excluding sign).")
(define-module :stdlib.hash-table)

View File

@@ -0,0 +1,166 @@
;; Tests for mutable hash tables (Phase 10)
(defsuite
"hash-table"
(deftest
"make-hash-table returns a hash table"
(assert (hash-table? (make-hash-table))))
(deftest
"hash-table? false for dict"
(assert= false (hash-table? {:a 1})))
(deftest "hash-table? false for nil" (assert= false (hash-table? nil)))
(deftest
"hash-table? false for list"
(assert= false (hash-table? (list 1 2))))
(deftest
"empty table has size 0"
(assert= 0 (hash-table-size (make-hash-table))))
(deftest
"size after one set"
(let
((ht (make-hash-table)))
(hash-table-set! ht "a" 1)
(assert= 1 (hash-table-size ht))))
(deftest
"size after multiple sets"
(let
((ht (make-hash-table)))
(hash-table-set! ht "a" 1)
(hash-table-set! ht "b" 2)
(hash-table-set! ht "c" 3)
(assert= 3 (hash-table-size ht))))
(deftest
"set same key does not grow size"
(let
((ht (make-hash-table)))
(hash-table-set! ht "a" 1)
(hash-table-set! ht "a" 2)
(assert= 1 (hash-table-size ht))))
(deftest
"ref returns set value"
(let
((ht (make-hash-table)))
(hash-table-set! ht "k" 42)
(assert= 42 (hash-table-ref ht "k"))))
(deftest
"ref returns updated value after overwrite"
(let
((ht (make-hash-table)))
(hash-table-set! ht "k" 1)
(hash-table-set! ht "k" 99)
(assert= 99 (hash-table-ref ht "k"))))
(deftest
"ref with default returns default for missing key"
(assert=
"fallback"
(hash-table-ref (make-hash-table) "missing" "fallback")))
(deftest
"ref with default returns value when key exists"
(let
((ht (make-hash-table)))
(hash-table-set! ht "x" 7)
(assert= 7 (hash-table-ref ht "x" 0))))
(deftest
"keyword keys work"
(let
((ht (make-hash-table)))
(hash-table-set! ht :foo "bar")
(assert= "bar" (hash-table-ref ht :foo))))
(deftest
"number keys work"
(let
((ht (make-hash-table)))
(hash-table-set! ht 0 "zero")
(assert= "zero" (hash-table-ref ht 0))))
(deftest
"delete removes key"
(let
((ht (make-hash-table)))
(hash-table-set! ht "x" 1)
(hash-table-delete! ht "x")
(assert= "gone" (hash-table-ref ht "x" "gone"))))
(deftest
"delete reduces size"
(let
((ht (make-hash-table)))
(hash-table-set! ht "a" 1)
(hash-table-set! ht "b" 2)
(hash-table-delete! ht "a")
(assert= 1 (hash-table-size ht))))
(deftest
"delete missing key is no-op"
(let
((ht (make-hash-table)))
(hash-table-delete! ht "absent")
(assert= 0 (hash-table-size ht))))
(deftest
"keys of empty table is empty"
(assert (empty? (hash-table-keys (make-hash-table)))))
(deftest
"keys has correct count"
(let
((ht (make-hash-table)))
(hash-table-set! ht "a" 1)
(hash-table-set! ht "b" 2)
(assert= 2 (len (hash-table-keys ht)))))
(deftest
"values has correct count"
(let
((ht (make-hash-table)))
(hash-table-set! ht "a" 10)
(hash-table-set! ht "b" 20)
(assert= 2 (len (hash-table-values ht)))))
(deftest
"alist of empty table is empty"
(assert (empty? (hash-table->alist (make-hash-table)))))
(deftest
"alist has correct length"
(let
((ht (make-hash-table)))
(hash-table-set! ht "x" 1)
(hash-table-set! ht "y" 2)
(assert= 2 (len (hash-table->alist ht)))))
(deftest
"for-each visits all entries"
(let
((ht (make-hash-table)) (count 0))
(hash-table-set! ht "a" 1)
(hash-table-set! ht "b" 2)
(hash-table-set! ht "c" 3)
(hash-table-for-each ht (fn (k v) (set! count (+ count 1))))
(assert= 3 count)))
(deftest
"for-each sums values"
(let
((ht (make-hash-table)) (total 0))
(hash-table-set! ht "a" 10)
(hash-table-set! ht "b" 20)
(hash-table-set! ht "c" 30)
(hash-table-for-each ht (fn (k v) (set! total (+ total v))))
(assert= 60 total)))
(deftest
"merge copies entries from src to dst"
(let
((dst (make-hash-table)) (src (make-hash-table)))
(hash-table-set! src "x" 1)
(hash-table-set! src "y" 2)
(hash-table-merge! dst src)
(assert= 2 (hash-table-size dst))))
(deftest
"merge overwrites existing keys in dst"
(let
((dst (make-hash-table)) (src (make-hash-table)))
(hash-table-set! dst "k" "old")
(hash-table-set! src "k" "new")
(hash-table-merge! dst src)
(assert= "new" (hash-table-ref dst "k"))))
(deftest
"merge does not modify src"
(let
((dst (make-hash-table)) (src (make-hash-table)))
(hash-table-set! src "a" 1)
(hash-table-merge! dst src)
(assert= 1 (hash-table-size src))))
(deftest
"type-of returns hash-table"
(assert= "hash-table" (type-of (make-hash-table)))))