Fix WASM browser click handlers: 8 bugs, 50 new VM tests

The sx-get links were doing full page refreshes because click handlers never attached. Root causes: VM frame management bug, missing primitives, CEK/VM type dispatch mismatch, and silent error swallowing. Fixes: - VM frame exhaustion: frames <- [] now properly pops to rest_frames - length primitive: add alias for len in OCaml primitives - call_sx_fn: use sx_call directly instead of eval_expr (CEK checks for type "lambda" but VmClosure reports "function") - Boot error surfacing: Sx.init() now has try/catch + failure summary - Callback error surfacing: catch-all handler for non-Eval_error exceptions - Silent JIT failures: log before CEK fallback instead of swallowing - vm→env sync: loadModule now calls sync_vm_to_env() - sx_build_bytecode MCP tool added for bytecode compilation Tests: 50 new tests across test-vm.sx and test-vm-primitives.sx covering nested VM calls, frame integrity, CEK bridge, primitive availability, cross-module symbol resolution, and callback dispatch. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-03-27 00:37:21 +00:00
parent 00de248ee9
commit c923a34fa8
38 changed files with 6016 additions and 4513 deletions
--- a/hosts/ocaml/bin/mcp_tree.ml
+++ b/hosts/ocaml/bin/mcp_tree.ml
@@ -519,6 +519,21 @@ let rec handle_tool name args =
     | Unix.WEXITED 0 -> text_result (Printf.sprintf "OK — %s build succeeded\n%s" target (String.trim output))
     | _ -> error_result (Printf.sprintf "%s build failed:\n%s" target output))

+  | "sx_build_bytecode" ->
+    let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
+      let spec_dir = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
+      Filename.dirname spec_dir
+    in
+    let cmd = Printf.sprintf "cd %s && node hosts/ocaml/browser/compile-modules.js shared/static/wasm 2>&1" project_dir in
+    let ic = Unix.open_process_in cmd in
+    let lines = ref [] in
+    (try while true do lines := input_line ic :: !lines done with End_of_file -> ());
+    let status = Unix.close_process_in ic in
+    let output = String.concat "\n" (List.rev !lines) in
+    (match status with
+     | Unix.WEXITED 0 -> text_result (Printf.sprintf "OK — bytecode compilation succeeded\n%s" (String.trim output))
+     | _ -> error_result (Printf.sprintf "Bytecode compilation failed:\n%s" output))
+
  | "sx_test" ->
    let host = args |> member "host" |> to_string_option |> Option.value ~default:"js" in
    let full = args |> member "full" |> to_bool_option |> Option.value ~default:false in
@@ -748,8 +763,10 @@ let rec handle_tool name args =
        (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
+      let args_json = Yojson.Basic.to_string inspector_args in
+      (* Single-quote shell wrapping — escape any literal single quotes in JSON *)
+      let shell_safe = String.concat "'\\''" (String.split_on_char '\'' args_json) in
+      let cmd = Printf.sprintf "cd %s && node tests/playwright/sx-inspect.js '%s' 2>&1" project_dir shell_safe in
      let ic = Unix.open_process_in cmd in
      let lines = ref [] in
      (try while true do lines := input_line ic :: !lines done with End_of_file -> ());
@@ -1304,6 +1321,8 @@ let tool_definitions = `List [
    [("target", `Assoc [("type", `String "string"); ("description", `String "Build target: \"js\" (default) or \"ocaml\"")]);
     ("full", `Assoc [("type", `String "boolean"); ("description", `String "Include extensions and type system (default: false)")])]
    [];
+  tool "sx_build_bytecode" "Compile all web .sx files to pre-compiled .sxbc.json bytecode modules for the WASM browser kernel."
+    [] [];
  tool "sx_test" "Run SX test suite. Returns pass/fail summary and any failures."
    [("host", `Assoc [("type", `String "string"); ("description", `String "Test host: \"js\" (default) or \"ocaml\"")]);
     ("full", `Assoc [("type", `String "boolean"); ("description", `String "Run full test suite including extensions (default: false)")])]
@@ -1354,13 +1373,13 @@ 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/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."
+  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, listeners (CDP event listener inspection), trace (click + capture console/network/pushState), cdp (raw CDP command)."
    [("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, hydrate, eval, interact, screenshot")]);
+     ("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: run, inspect, diff, hydrate, eval, interact, screenshot, listeners, trace, cdp")]);
     ("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)")]);
+     ("selector", `Assoc [("type", `String "string"); ("description", `String "CSS selector for screenshot/listeners/trace modes")]);
+     ("expr", `Assoc [("type", `String "string"); ("description", `String "JS expression (eval mode), selector (listeners/trace), or CDP command (cdp 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")])]
    [];
 ]
--- a/hosts/ocaml/browser/sx_browser.ml
+++ b/hosts/ocaml/browser/sx_browser.ml
@@ -58,7 +58,8 @@ let global_env = make_env ()
 let _sx_render_mode = ref false

 let call_sx_fn (fn : value) (args : value list) : value =
-  Sx_ref.eval_expr (List (fn :: args)) (Env global_env)
+  let result = Sx_runtime.sx_call fn args in
+  !Sx_primitives._sx_trampoline_fn result

 (* ================================================================== *)
 (* Value conversion: OCaml <-> JS                                      *)
@@ -107,10 +108,18 @@ let rec value_to_js (v : value) : Js.Unsafe.any =
        let args = match arg with Nil -> [] | _ -> [arg] in
        let result = call_sx_fn v args in
        value_to_js result
-      with Eval_error msg ->
+      with
+      | Eval_error msg ->
+        let fn_info = Printf.sprintf " [callback %s handle=%d]" (type_of v) handle in
        ignore (Js.Unsafe.meth_call
          (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
-          "error" [| Js.Unsafe.inject (Js.string ("[sx] " ^ msg)) |]);
+          "error" [| Js.Unsafe.inject (Js.string ("[sx] " ^ msg ^ fn_info)) |]);
+        Js.Unsafe.inject Js.null
+      | exn ->
+        let fn_info = Printf.sprintf " [callback %s handle=%d]" (type_of v) handle in
+        ignore (Js.Unsafe.meth_call
+          (Js.Unsafe.get Js.Unsafe.global (Js.string "console"))
+          "error" [| Js.Unsafe.inject (Js.string ("[sx] UNCAUGHT: " ^ Printexc.to_string exn ^ fn_info)) |]);
        Js.Unsafe.inject Js.null) in
    Js.Unsafe.fun_call _tag_fn [|
      Js.Unsafe.inject inner;
@@ -189,6 +198,31 @@ and js_to_value (js : Js.Unsafe.any) : value =
 let return_via_side_channel (v : Js.Unsafe.any) : Js.Unsafe.any =
  Js.Unsafe.set Js.Unsafe.global (Js.string "__sxR") v; v

+(* ================================================================== *)
+(* Persistent VM globals — synced with global_env                      *)
+(* ================================================================== *)
+
+(* String-keyed mirror of global_env.bindings for VmClosures.
+   VmClosures from bytecode modules hold vm_env_ref pointing here.
+   Must stay in sync so VmClosures see post-boot definitions. *)
+let _vm_globals : (string, value) Hashtbl.t = Hashtbl.create 512
+let _in_batch = ref false
+
+(* Sync env→VM: copy all bindings from global_env.bindings to _vm_globals.
+   Called after CEK eval/load so VmClosures can see new definitions. *)
+let sync_env_to_vm () =
+  Hashtbl.iter (fun id v ->
+    Hashtbl.replace _vm_globals (unintern id) v
+  ) global_env.bindings
+
+(* Hook: intercept env_bind on global_env to also update _vm_globals.
+   This ensures VmClosures see new definitions immediately, even during
+   a single boot-init call that loads page scripts and components. *)
+let () =
+  Sx_types._env_bind_hook := Some (fun env name v ->
+    if env == global_env then
+      Hashtbl.replace _vm_globals name v)
+
 (* ================================================================== *)
 (* Core API                                                            *)
 (* ================================================================== *)
@@ -207,6 +241,7 @@ let api_eval src_js =
    let exprs = Sx_parser.parse_all src in
    let env = Env global_env in
    let result = List.fold_left (fun _acc expr -> Sx_ref.eval_expr expr env) Nil exprs in
+    sync_env_to_vm ();
    return_via_side_channel (value_to_js result)
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
@@ -215,7 +250,9 @@ let api_eval src_js =
 let api_eval_expr expr_js _env_js =
  let expr = js_to_value expr_js in
  try
-    return_via_side_channel (value_to_js (Sx_ref.eval_expr expr (Env global_env)))
+    let result = Sx_ref.eval_expr expr (Env global_env) in
+    sync_env_to_vm ();
+    return_via_side_channel (value_to_js result)
  with Eval_error msg ->
    Js.Unsafe.inject (Js.string ("Error: " ^ msg))

@@ -226,56 +263,66 @@ let api_load src_js =
    let env = Env global_env in
    let count = ref 0 in
    List.iter (fun expr -> ignore (Sx_ref.eval_expr expr env); incr count) exprs;
+    sync_env_to_vm ();
    Js.Unsafe.inject !count
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | Parse_error msg -> Js.Unsafe.inject (Js.string ("Parse error: " ^ msg))

-(* Shared globals table for batch module loading.
-   Created by beginModuleLoad, accumulated across loadModule calls,
-   flushed to env by endModuleLoad. Ensures closures from early
-   modules can see definitions from later modules. *)
-let _module_globals : (string, value) Hashtbl.t option ref = ref None
-
 let api_begin_module_load () =
-  let g = Hashtbl.create 512 in
-  Hashtbl.iter (fun id v -> Hashtbl.replace g (unintern id) v) global_env.bindings;
-  _module_globals := Some g;
+  (* Snapshot current env into the persistent VM globals table *)
+  Hashtbl.clear _vm_globals;
+  Hashtbl.iter (fun id v -> Hashtbl.replace _vm_globals (unintern id) v) global_env.bindings;
+  _in_batch := true;
  Js.Unsafe.inject true

 let api_end_module_load () =
-  (match !_module_globals with
-   | Some g ->
-     Hashtbl.iter (fun k v ->
-       Hashtbl.replace global_env.bindings (intern k) v
-     ) g;
-     _module_globals := None
-   | None -> ());
+  if !_in_batch then begin
+    (* Copy VM globals back to env (bytecode modules defined new symbols) *)
+    Hashtbl.iter (fun k v ->
+      Hashtbl.replace global_env.bindings (intern k) v
+    ) _vm_globals;
+    _in_batch := false
+  end;
  Js.Unsafe.inject true

+let sync_vm_to_env () =
+  Hashtbl.iter (fun name v ->
+    let id = intern name in
+    if not (Hashtbl.mem global_env.bindings id) then
+      Hashtbl.replace global_env.bindings id v
+    else begin
+      (* Update existing binding if the VM has a newer value *)
+      let existing = Hashtbl.find global_env.bindings id in
+      match existing, v with
+      | VmClosure _, VmClosure _ -> Hashtbl.replace global_env.bindings id v
+      | _, VmClosure _ -> Hashtbl.replace global_env.bindings id v
+      | _ -> ()
+    end
+  ) _vm_globals
+
 let api_load_module module_js =
  try
    let code_val = js_to_value module_js in
    let code = Sx_vm.code_from_value code_val in
-    let globals = match !_module_globals with
-      | Some g -> g  (* use shared table *)
-      | None ->
-        (* standalone mode: create temp table *)
-        let g = Hashtbl.create 256 in
-        Hashtbl.iter (fun id v -> Hashtbl.replace g (unintern id) v) global_env.bindings;
-        g
-    in
-    let _result = Sx_vm.execute_module code globals in
-    (* If standalone (no batch), copy back immediately *)
-    if !_module_globals = None then
-      Hashtbl.iter (fun k v ->
-        Hashtbl.replace global_env.bindings (intern k) v
-      ) globals;
-    Js.Unsafe.inject (Hashtbl.length globals)
+    let _result = Sx_vm.execute_module code _vm_globals in
+    sync_vm_to_env ();
+    Js.Unsafe.inject (Hashtbl.length _vm_globals)
  with
  | Eval_error msg -> Js.Unsafe.inject (Js.string ("Error: " ^ msg))
  | exn -> Js.Unsafe.inject (Js.string ("Error: " ^ Printexc.to_string exn))

+let api_debug_env name_js =
+  let name = Js.to_string name_js in
+  let id = intern name in
+  let found_env = Hashtbl.find_opt global_env.bindings id in
+  let found_vm = Hashtbl.find_opt _vm_globals name in
+  let total_env = Hashtbl.length global_env.bindings in
+  let total_vm = Hashtbl.length _vm_globals in
+  let env_s = match found_env with Some v -> "env:" ^ type_of v | None -> "env:MISSING" in
+  let vm_s = match found_vm with Some v -> "vm:" ^ type_of v | None -> "vm:MISSING" in
+  Js.Unsafe.inject (Js.string (Printf.sprintf "%s %s (env=%d vm=%d)" env_s vm_s total_env total_vm))
+
 let api_compile_module src_js =
  let src = Js.to_string src_js in
  try
@@ -318,7 +365,9 @@ let api_register_native name_js callback_js =
    let js_args = args |> List.map value_to_js |> Array.of_list in
    js_to_value (Js.Unsafe.fun_call callback_js [| Js.Unsafe.inject (Js.array js_args) |])
  in
-  ignore (env_bind global_env name (NativeFn (name, native_fn)));
+  let v = NativeFn (name, native_fn) in
+  ignore (env_bind global_env name v);
+  Hashtbl.replace _vm_globals name v;
  Js.Unsafe.inject Js.null

 let api_call_fn fn_js args_js =
@@ -627,18 +676,12 @@ let _jit_compiling = ref false
 let _jit_enabled = ref false

 let () =
-  (* 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.bindings) in
-    Hashtbl.iter (fun id v -> Hashtbl.replace g (unintern id) v) env.bindings;
-    g
-  in
  Sx_ref.jit_call_hook := Some (fun f args ->
    match f with
    | Lambda l when !_jit_enabled ->
      (match l.l_compiled with
       | Some cl when not (Sx_vm.is_jit_failed cl) ->
-         (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
+         (try Some (Sx_vm.call_closure cl args _vm_globals)
          with Eval_error msg ->
            let fn_name = match l.l_name with Some n -> n | None -> "?" in
            Printf.eprintf "[jit] DISABLED %s — %s\n%!" fn_name msg;
@@ -649,13 +692,12 @@ let () =
         if !_jit_compiling then None
         else begin
           _jit_compiling := true;
-           let globals = env_to_vm_globals global_env in
-           let compiled = Sx_vm.jit_compile_lambda l globals in
+           let compiled = Sx_vm.jit_compile_lambda l _vm_globals in
           _jit_compiling := false;
           (match compiled with
           | Some cl ->
             l.l_compiled <- Some cl;
-             (try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
+             (try Some (Sx_vm.call_closure cl args _vm_globals)
              with _ ->
                l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
                None)
@@ -693,5 +735,6 @@ let () =
  Js.Unsafe.set sx (Js.string "callFn") (wrap api_call_fn);
  Js.Unsafe.set sx (Js.string "isCallable") (Js.wrap_callback api_is_callable);
  Js.Unsafe.set sx (Js.string "fnArity") (Js.wrap_callback api_fn_arity);
+  Js.Unsafe.set sx (Js.string "debugEnv") (Js.wrap_callback api_debug_env);

  Js.Unsafe.set Js.Unsafe.global (Js.string "SxKernel") sx
--- a/hosts/ocaml/lib/sx_primitives.ml
+++ b/hosts/ocaml/lib/sx_primitives.ml
@@ -362,6 +362,7 @@ let () =
    | [Macro _] | [Thunk _] | [Keyword _] | [Symbol _] -> Number 0.0
    | _ -> raise (Eval_error (Printf.sprintf "len: %d args"
        (List.length args))));
+  register "length" (Hashtbl.find primitives "len");
  register "first" (fun args ->
    match args with
    | [List (x :: _)] | [ListRef { contents = x :: _ }] -> x
--- a/hosts/ocaml/lib/sx_vm.ml
+++ b/hosts/ocaml/lib/sx_vm.ml
@@ -148,7 +148,11 @@ and vm_call vm f args =
       (* Cached bytecode — run on VM using the closure's captured env,
          not the caller's globals. Closure vars were merged at compile time. *)
       (try push vm (call_closure cl args cl.vm_env_ref)
-        with _ -> push vm (Sx_ref.cek_call f (List args)))
+        with e ->
+          let msg = match e with Eval_error m -> m | e -> Printexc.to_string e in
+          Printf.eprintf "[vm] JIT call failed for %s: %s — falling back to CEK\n%!"
+            (match l.l_name with Some n -> n | None -> "<anon>") msg;
+          push vm (Sx_ref.cek_call f (List args)))
     | Some _ ->
       (* Compile failed — CEK *)
       push vm (Sx_ref.cek_call f (List args))
@@ -161,7 +165,10 @@ and vm_call vm f args =
         | Some cl ->
           l.l_compiled <- Some cl;
           (try push vm (call_closure cl args cl.vm_env_ref)
-            with _ ->
+            with e ->
+              let msg = match e with Eval_error m -> m | e -> Printexc.to_string e in
+              Printf.eprintf "[vm] JIT first-call failed for %s: %s — marking failed, falling back to CEK\n%!"
+                (match l.l_name with Some n -> n | None -> "<anon>") msg;
              l.l_compiled <- Some jit_failed_sentinel;
              push vm (Sx_ref.cek_call f (List args)))
         | None ->
@@ -187,8 +194,17 @@ and run vm =
    | frame :: rest_frames ->
      let bc = frame.closure.vm_code.vc_bytecode in
      let consts = frame.closure.vm_code.vc_constants in
-      if frame.ip >= Array.length bc then
-        vm.frames <- []  (* bytecode exhausted — stop *)
+      if frame.ip >= Array.length bc then begin
+        (* Bytecode exhausted without explicit RETURN — pop frame like RETURN *)
+        let fn_name = match frame.closure.vm_name with Some n -> n | None -> "?" in
+        Printf.eprintf "[vm] WARN: bytecode exhausted without RETURN in %s (base=%d sp=%d frames=%d)\n%!"
+          fn_name frame.base vm.sp (List.length rest_frames);
+        let result = if vm.sp > frame.base then pop vm else Nil in
+        vm.frames <- rest_frames;
+        vm.sp <- frame.base;
+        if rest_frames <> [] then push vm result
+        (* If no more frames, result stays on stack for call_closure to pop *)
+      end
      else begin
        let saved_ip = frame.ip in
        let op = bc.(frame.ip) in
@@ -612,4 +628,5 @@ let jit_compile_lambda (l : lambda) globals =

 (* Wire up forward references *)
 let () = jit_compile_ref := jit_compile_lambda
-let () = _vm_call_closure_ref := (fun cl args -> call_closure cl args cl.vm_env_ref)
+let () = _vm_call_closure_ref := (fun cl args ->
+  call_closure cl args cl.vm_env_ref)