WASM browser build: interned env keys, async kernel boot, bundled .sx platform
- 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:
@@ -315,7 +315,7 @@ let make_integration_env () =
|
||||
let body_env = { bindings = Hashtbl.create 16; parent = Some e } in
|
||||
List.iteri (fun i p ->
|
||||
let v = if i < List.length macro_args then List.nth macro_args i else Nil in
|
||||
Hashtbl.replace body_env.bindings p v
|
||||
Hashtbl.replace body_env.bindings (Sx_types.intern p) v
|
||||
) m.m_params;
|
||||
Sx_ref.eval_expr m.m_body (Env body_env)
|
||||
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
|
||||
|
||||
@@ -709,6 +709,7 @@ let rec handle_tool name args =
|
||||
let selector = args |> member "selector" |> to_string_option in
|
||||
let expr = args |> member "expr" |> to_string_option in
|
||||
let actions = args |> member "actions" |> to_string_option in
|
||||
let island = args |> member "island" |> to_string_option in
|
||||
(* Determine whether to run specs or the inspector *)
|
||||
let use_inspector = match mode with
|
||||
| Some m when m <> "run" -> true
|
||||
@@ -745,6 +746,7 @@ let rec handle_tool name args =
|
||||
(match selector with Some s -> Some ("selector", `String s) | None -> None);
|
||||
(match expr with Some e -> Some ("expr", `String e) | None -> None);
|
||||
(match actions with Some a -> Some ("actions", `String a) | None -> None);
|
||||
(match island with Some i -> Some ("island", `String i) | None -> None);
|
||||
]) in
|
||||
let args_json = Yojson.Safe.to_string (Yojson.Safe.from_string (Yojson.Basic.to_string inspector_args)) in
|
||||
let cmd = Printf.sprintf "cd %s && node tests/playwright/sx-inspect.js '%s' 2>&1" project_dir (String.escaped args_json) in
|
||||
@@ -1154,14 +1156,15 @@ let rec handle_tool name args =
|
||||
let bindings = ref [] in
|
||||
(* Walk env chain collecting all bindings *)
|
||||
let rec collect_bindings env acc =
|
||||
Hashtbl.iter (fun k v ->
|
||||
if not (Hashtbl.mem acc k) then Hashtbl.replace acc k v
|
||||
Hashtbl.iter (fun id v ->
|
||||
if not (Hashtbl.mem acc id) then Hashtbl.replace acc id v
|
||||
) env.bindings;
|
||||
match env.parent with Some p -> collect_bindings p acc | None -> ()
|
||||
in
|
||||
let all = Hashtbl.create 256 in
|
||||
collect_bindings e all;
|
||||
Hashtbl.iter (fun k v ->
|
||||
Hashtbl.iter (fun id v ->
|
||||
let k = Sx_types.unintern id in
|
||||
let kind = match v with
|
||||
| NativeFn _ -> "native"
|
||||
| Lambda _ -> "lambda"
|
||||
@@ -1351,10 +1354,11 @@ let tool_definitions = `List [
|
||||
("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String "Multiple .sx files to load in order")]);
|
||||
("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression to run before main evaluation")])]
|
||||
["expr"];
|
||||
tool "sx_playwright" "Run Playwright browser tests or inspect SX pages interactively. Modes: run (spec files), inspect (page report), diff (SSR vs hydrated), eval (JS expression), interact (action sequence), screenshot."
|
||||
tool "sx_playwright" "Run Playwright browser tests or inspect SX pages interactively. Modes: run (spec files), inspect (page/island report with leak detection and handler audit), diff (full SSR vs hydrated DOM), hydrate (lake-focused SSR vs hydrated comparison — detects clobbering), eval (JS expression), interact (action sequence), screenshot."
|
||||
[("spec", `Assoc [("type", `String "string"); ("description", `String "Spec file to run (run mode). e.g. stepper.spec.js")]);
|
||||
("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: run, inspect, diff, eval, interact, screenshot")]);
|
||||
("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: run, inspect, diff, hydrate, eval, interact, screenshot")]);
|
||||
("url", `Assoc [("type", `String "string"); ("description", `String "URL path to navigate to (default: /)")]);
|
||||
("island", `Assoc [("type", `String "string"); ("description", `String "Filter inspect to a specific island by name (e.g. home/stepper)")]);
|
||||
("selector", `Assoc [("type", `String "string"); ("description", `String "CSS selector to focus on (screenshot mode)")]);
|
||||
("expr", `Assoc [("type", `String "string"); ("description", `String "JS expression to evaluate (eval mode)")]);
|
||||
("actions", `Assoc [("type", `String "string"); ("description", `String "Semicolon-separated action sequence (interact mode). Actions: click:sel, fill:sel:val, wait:ms, text:sel, html:sel, attrs:sel, screenshot, screenshot:sel, count:sel, visible:sel")])]
|
||||
|
||||
@@ -407,7 +407,7 @@ let setup_evaluator_bridge env =
|
||||
let body_env = { bindings = Hashtbl.create 16; parent = Some e } in
|
||||
List.iteri (fun i p ->
|
||||
let v = if i < List.length macro_args then List.nth macro_args i else Nil in
|
||||
Hashtbl.replace body_env.bindings p v
|
||||
Hashtbl.replace body_env.bindings (Sx_types.intern p) v
|
||||
) m.m_params;
|
||||
Sx_ref.eval_expr m.m_body (Env body_env)
|
||||
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
|
||||
@@ -629,6 +629,12 @@ let setup_html_tags env =
|
||||
(* Compose environment *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
(** Convert int-keyed env.bindings to string-keyed Hashtbl for VM globals *)
|
||||
let env_to_vm_globals env =
|
||||
let g = Hashtbl.create (Hashtbl.length env.Sx_types.bindings) in
|
||||
Hashtbl.iter (fun id v -> Hashtbl.replace g (Sx_types.unintern id) v) env.Sx_types.bindings;
|
||||
g
|
||||
|
||||
let make_server_env () =
|
||||
let env = make_env () in
|
||||
Sx_render.setup_render_env env;
|
||||
@@ -703,7 +709,7 @@ let register_jit_hook env =
|
||||
else begin
|
||||
_jit_compiling := true;
|
||||
let t0 = Unix.gettimeofday () in
|
||||
let compiled = Sx_vm.jit_compile_lambda l env.bindings in
|
||||
let compiled = Sx_vm.jit_compile_lambda l (env_to_vm_globals env) in
|
||||
let dt = Unix.gettimeofday () -. t0 in
|
||||
_jit_compiling := false;
|
||||
Printf.eprintf "[jit] %s compile %s in %.3fs\n%!"
|
||||
@@ -726,7 +732,7 @@ let register_jit_hook env =
|
||||
evaluator.sx defines *custom-special-forms* and register-special-form!
|
||||
which shadow the native bindings from setup_evaluator_bridge. *)
|
||||
let rebind_host_extensions env =
|
||||
Hashtbl.replace env.bindings "register-special-form!"
|
||||
Hashtbl.replace env.bindings (Sx_types.intern "register-special-form!")
|
||||
(NativeFn ("register-special-form!", fun args ->
|
||||
match args with
|
||||
| [String name; handler] ->
|
||||
@@ -814,7 +820,7 @@ let rec dispatch env cmd =
|
||||
| List [Symbol "vm-reset-fn"; String name] ->
|
||||
(* Reset a function's JIT-compiled bytecode, forcing CEK interpretation.
|
||||
Used to work around JIT compilation bugs in specific functions. *)
|
||||
(match Hashtbl.find_opt env.bindings name with
|
||||
(match Hashtbl.find_opt env.bindings (Sx_types.intern name) with
|
||||
| Some (Lambda l) ->
|
||||
l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
|
||||
Printf.eprintf "[jit] reset %s (forced CEK)\n%!" name;
|
||||
@@ -889,10 +895,10 @@ let rec dispatch env cmd =
|
||||
"current-offset"; "patch-i16";
|
||||
] in
|
||||
List.iter (fun name ->
|
||||
match Hashtbl.find_opt env.bindings name with
|
||||
match Hashtbl.find_opt env.bindings (Sx_types.intern name) with
|
||||
| Some (Lambda l) when l.l_compiled = None ->
|
||||
l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
|
||||
(match Sx_vm.jit_compile_lambda l env.bindings with
|
||||
(match Sx_vm.jit_compile_lambda l (env_to_vm_globals env) with
|
||||
| Some cl -> l.l_compiled <- Some cl; incr count
|
||||
| None -> ())
|
||||
| _ -> ()
|
||||
@@ -937,7 +943,7 @@ let rec dispatch env cmd =
|
||||
in
|
||||
let t1 = Unix.gettimeofday () in
|
||||
io_batch_mode := false;
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
let result_str = match result with
|
||||
| String s | SxExpr s -> s
|
||||
| _ -> serialize_value result
|
||||
@@ -953,12 +959,12 @@ let rec dispatch env cmd =
|
||||
| Eval_error msg ->
|
||||
io_batch_mode := false;
|
||||
io_queue := [];
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
send_error msg
|
||||
| exn ->
|
||||
io_batch_mode := false;
|
||||
io_queue := [];
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
send_error (Printexc.to_string exn))
|
||||
|
||||
| List (Symbol "sx-page-full-blob" :: shell_kwargs) ->
|
||||
@@ -991,7 +997,7 @@ let rec dispatch env cmd =
|
||||
in
|
||||
let t1 = Unix.gettimeofday () in
|
||||
io_batch_mode := false;
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
let body_str = match body_result with
|
||||
| String s | SxExpr s -> s
|
||||
| _ -> serialize_value body_result
|
||||
@@ -1038,12 +1044,12 @@ let rec dispatch env cmd =
|
||||
| Eval_error msg ->
|
||||
io_batch_mode := false;
|
||||
io_queue := [];
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
send_error msg
|
||||
| exn ->
|
||||
io_batch_mode := false;
|
||||
io_queue := [];
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
Hashtbl.remove env.bindings (Sx_types.intern "expand-components?");
|
||||
send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "render"; String src] ->
|
||||
@@ -1065,8 +1071,7 @@ let rec dispatch env cmd =
|
||||
code_val is a dict with {bytecode, pool} from compiler.sx *)
|
||||
(try
|
||||
let code = Sx_vm.code_from_value code_val in
|
||||
let globals = Hashtbl.create 256 in
|
||||
Hashtbl.iter (fun k v -> Hashtbl.replace globals k v) env.bindings;
|
||||
let globals = env_to_vm_globals env in
|
||||
let result = Sx_vm.execute_module code globals in
|
||||
send_ok_value result
|
||||
with
|
||||
@@ -1081,8 +1086,10 @@ let rec dispatch env cmd =
|
||||
(try
|
||||
let code = Sx_vm.code_from_value code_val in
|
||||
(* VM uses the LIVE kernel env — defines go directly into it *)
|
||||
let _result = Sx_vm.execute_module code env.bindings in
|
||||
(* Count how many defines the module added *)
|
||||
let globals = env_to_vm_globals env in
|
||||
let _result = Sx_vm.execute_module code globals in
|
||||
(* Copy defines back into env *)
|
||||
Hashtbl.iter (fun k v -> Hashtbl.replace env.bindings (Sx_types.intern k) v) globals;
|
||||
send_ok ()
|
||||
with
|
||||
| Eval_error msg -> send_error msg
|
||||
|
||||
@@ -27,29 +27,29 @@ cp "$BUILD/sx_browser.bc.js" "$DIST/"
|
||||
cp sx-platform.js "$DIST/"
|
||||
|
||||
# 3. Spec modules
|
||||
cp "$ROOT/spec/signals.sx" "$DIST/sx/core-signals.sx"
|
||||
cp "$ROOT/spec/render.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/signals.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/deps.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/router.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/page-helpers.sx" "$DIST/sx/"
|
||||
cp "$ROOT/spec/signals.sx" "$DIST/sx/core-signals.sx"
|
||||
cp "$ROOT/spec/render.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/web-signals.sx" "$DIST/sx/signals.sx"
|
||||
cp "$ROOT/web/deps.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/router.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/page-helpers.sx" "$DIST/sx/"
|
||||
|
||||
# 3b. Freeze scope (signal persistence)
|
||||
cp "$ROOT/lib/freeze.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/freeze.sx" "$DIST/sx/"
|
||||
|
||||
# 4. Bytecode compiler + VM
|
||||
cp "$ROOT/lib/bytecode.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/compiler.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/vm.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/bytecode.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/compiler.sx" "$DIST/sx/"
|
||||
cp "$ROOT/lib/vm.sx" "$DIST/sx/"
|
||||
|
||||
# 5. Web libraries (8 FFI primitives)
|
||||
cp "$ROOT/web/lib/dom.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/lib/browser.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/lib/dom.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/lib/browser.sx" "$DIST/sx/"
|
||||
|
||||
# 6. Web adapters
|
||||
cp "$ROOT/web/adapter-html.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-sx.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-dom.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-html.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-sx.sx" "$DIST/sx/"
|
||||
cp "$ROOT/web/adapter-dom.sx" "$DIST/sx/"
|
||||
|
||||
# 7. Boot helpers (platform functions in pure SX)
|
||||
cp "$ROOT/web/lib/boot-helpers.sx" "$DIST/sx/"
|
||||
|
||||
5
hosts/ocaml/browser/dune
Normal file
5
hosts/ocaml/browser/dune
Normal file
@@ -0,0 +1,5 @@
|
||||
(executable
|
||||
(name sx_browser)
|
||||
(libraries sx js_of_ocaml)
|
||||
(modes byte js wasm)
|
||||
(preprocess (pps js_of_ocaml-ppx)))
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|
||||
Reference in New Issue
Block a user