coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

WASM browser build: interned env keys, async kernel boot, bundled .sx platform

Browse Source 
- Symbol interning in sx_types.ml: env lookups use int keys (intern/unintern)
  to avoid repeated string hashing in scope chain walks
- sx-platform.js: poll for SxKernel availability (WASM init is async)
- shell.sx: load sx_browser.bc.wasm.js when SX_USE_WASM=1
- bundle.sh: fix .sx file paths (web-signals.sx rename)
- browser/dune: target byte+js+wasm modes
- Bundle 23 .sx platform files for browser (dom, signals, router, boot, etc.)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-26 16:37:42 +00:00
parent 589507392c
commit 10576f86d1
25 changed files with 4808 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
hosts/ocaml/lib/sx_types.ml
View File

@@ -4,12 +4,38 @@
OCaml's algebraic types make the CEK machine's frame dispatch a
pattern match — exactly what the spec describes. *)
(** {1 Symbol interning} *)
(** Map symbol names to small integers for O(1) env lookups.
The intern table is populated once per unique symbol name;
all subsequent env operations use the integer key. *)
let sym_to_id : (string, int) Hashtbl.t = Hashtbl.create 512
let id_to_sym : (int, string) Hashtbl.t = Hashtbl.create 512
let sym_next = ref 0
let intern s =
match Hashtbl.find_opt sym_to_id s with
| Some id -> id
| None ->
let id = !sym_next in
incr sym_next;
Hashtbl.replace sym_to_id s id;
Hashtbl.replace id_to_sym id s;
id
let unintern id =
match Hashtbl.find_opt id_to_sym id with
| Some s -> s
| None -> "<sym:" ^ string_of_int id ^ ">"
(** {1 Environment} *)
(** Lexical scope chain. Each frame holds a mutable binding table and
an optional parent link for scope-chain lookup. *)
(** Lexical scope chain. Each frame holds a mutable binding table
keyed by interned symbol IDs for fast lookup. *)
type env = {
bindings : (string, value) Hashtbl.t;
bindings : (int, value) Hashtbl.t;
parent : env option;
}
@@ -160,36 +186,40 @@ let env_extend parent =
{ bindings = Hashtbl.create 16; parent = Some parent }
let env_bind env name v =
Hashtbl.replace env.bindings name v; Nil
Hashtbl.replace env.bindings (intern name) v; Nil
let rec env_has env name =
Hashtbl.mem env.bindings name ||
match env.parent with Some p -> env_has p name | None -> false
(* Internal: scope-chain lookup with pre-interned ID *)
let rec env_has_id env id =
Hashtbl.mem env.bindings id ||
match env.parent with Some p -> env_has_id p id | None -> false
let rec env_get env name =
match Hashtbl.find_opt env.bindings name with
let env_has env name = env_has_id env (intern name)
let rec env_get_id env id name =
match Hashtbl.find_opt env.bindings id with
| Some v -> v
| None ->
match env.parent with
| Some p -> env_get p name
| None -> raise (Eval_error ("Undefined symbol: " ^ name))
| Some p -> env_get_id p id name
| None ->
raise (Eval_error ("Undefined symbol: " ^ name))
let rec env_set env name v =
if Hashtbl.mem env.bindings name then
(Hashtbl.replace env.bindings name v; Nil)
let env_get env name = env_get_id env (intern name) name
let rec env_set_id env id v =
if Hashtbl.mem env.bindings id then
(Hashtbl.replace env.bindings id v; Nil)
else
match env.parent with
| Some p -> env_set p name v
| None -> Hashtbl.replace env.bindings name v; Nil
| Some p -> env_set_id p id v
| None -> Hashtbl.replace env.bindings id v; Nil
let env_set env name v = env_set_id env (intern name) v
let env_merge base overlay =
(* If base and overlay are the same env (physical equality) or overlay
is a descendant of base, just extend base — no copying needed.
This prevents set! inside lambdas from modifying shadow copies. *)
if base == overlay then
{ bindings = Hashtbl.create 16; parent = Some base }
else begin
(* Check if overlay is a descendant of base *)
let rec is_descendant e depth =
if depth > 100 then false
else if e == base then true
@@ -198,11 +228,9 @@ let env_merge base overlay =
if is_descendant overlay 0 then
{ bindings = Hashtbl.create 16; parent = Some base }
else begin
(* General case: extend base, copy ONLY overlay bindings that don't
exist anywhere in the base chain (avoids shadowing closure bindings). *)
let e = { bindings = Hashtbl.create 16; parent = Some base } in
Hashtbl.iter (fun k v ->
if not (env_has base k) then Hashtbl.replace e.bindings k v
Hashtbl.iter (fun id v ->
if not (env_has_id base id) then Hashtbl.replace e.bindings id v
) overlay.bindings;
e
end

10
hosts/ocaml/lib/sx_vm.ml
View File

@@ -242,8 +242,9 @@ and run vm =
let name = match consts.(idx) with String s -> s | _ -> "" in
let v = try Hashtbl.find vm.globals name with Not_found ->
(* Walk the closure env chain for inner functions *)
let id = Sx_types.intern name in
let rec env_lookup e =
try Hashtbl.find e.bindings name
try Hashtbl.find e.bindings id
with Not_found ->
match e.parent with Some p -> env_lookup p | None ->
try Sx_primitives.get_primitive name
@@ -262,9 +263,10 @@ and run vm =
(* Write to closure env if the name exists there (mutable closure vars) *)
let written = match frame.closure.vm_closure_env with
| Some env ->
let id = Sx_types.intern name in
let rec find_env e =
if Hashtbl.mem e.bindings name then
(Hashtbl.replace e.bindings name (peek vm); true)
if Hashtbl.mem e.bindings id then
(Hashtbl.replace e.bindings id (peek vm); true)
else match e.parent with Some p -> find_env p | None -> false
in find_env env
| None -> false
@@ -556,7 +558,7 @@ let jit_compile_lambda (l : lambda) globals =
Use a shallow copy so we don't pollute the real globals. *)
let merged = Hashtbl.copy globals in
let rec inject env =
Hashtbl.iter (fun k v -> Hashtbl.replace merged k v) env.bindings;
Hashtbl.iter (fun id v -> Hashtbl.replace merged (Sx_types.unintern id) v) env.bindings;
match env.parent with Some p -> inject p | None -> ()
in
inject closure;