From 133bdf529504b03cd368804c0cb0e7cfe26a1588 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 1 May 2026 08:48:41 +0000 Subject: [PATCH] spec: mutable hash tables (make-hash-table/ref/set!/delete!/etc) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- hosts/javascript/platform.py | 33 +++++- hosts/ocaml/lib/sx_primitives.ml | 62 +++++++++++- hosts/ocaml/lib/sx_types.ml | 3 + spec/primitives.sx | 2 + spec/tests/test-hash-table.sx | 166 +++++++++++++++++++++++++++++++ 5 files changed, 264 insertions(+), 2 deletions(-) create mode 100644 spec/tests/test-hash-table.sx diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index a1206078..26625cea 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -1030,7 +1030,7 @@ PRIMITIVES_JS_MODULES: dict[str, str] = { PRIMITIVES["inexact?"] = function(x) { return typeof x === "number" && !Number.isInteger(x); }; PRIMITIVES["string?"] = function(x) { return typeof x === "string"; }; 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["contains?"] = function(c, k) { 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; 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) @@ -1370,6 +1399,7 @@ PLATFORM_JS_PRE = ''' if (x._sx_expr) return "sx-expr"; if (x._vector) return "vector"; 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 (Array.isArray(x)) return "list"; if (typeof x === "object") return "dict"; @@ -1633,6 +1663,7 @@ PLATFORM_JS_POST = ''' if (isLambda(f)) return trampoline(callLambda(f, args, lambdaClosure(f))); return f.apply(null, args); }; + PRIMITIVES["apply"] = apply; // Additional primitive aliases used by adapter/engine transpiled code var split = PRIMITIVES["split"]; diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 1ea60180..325cfa33 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -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)")) diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index 204a44f7..c402a629 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -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 "" f.vf_ip f.vf_base | VmMachine m -> Printf.sprintf "" m.vm_sp (List.length m.vm_frames) | StringBuffer buf -> Printf.sprintf "" (Buffer.length buf) + | HashTable ht -> Printf.sprintf "" (Hashtbl.length ht) diff --git a/spec/primitives.sx b/spec/primitives.sx index 9cf49e61..b47e0655 100644 --- a/spec/primitives.sx +++ b/spec/primitives.sx @@ -849,3 +849,5 @@ :params ((a :as number)) :returns "number" :doc "Number of bits needed to represent integer a (excluding sign).") + +(define-module :stdlib.hash-table) diff --git a/spec/tests/test-hash-table.sx b/spec/tests/test-hash-table.sx new file mode 100644 index 00000000..4c888975 --- /dev/null +++ b/spec/tests/test-hash-table.sx @@ -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))))) \ No newline at end of file