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

Sandbox bytecode loading: K.load + load-sxbc, bytecode param, web stack sxbc via loadModule

Browse Source 
Bytecode modules now load correctly in sandbox mode. HS .sxbc modules
use K.load('(load-sxbc ...)') which syncs defines to eval env. Web stack
.sxbc modules use K.loadModule with import suspension drive loop.

K.eval used directly for expression eval (not thunk wrapper) so bytecode-
defined symbols are visible. Falls back to callFn thunk on IO suspension.

Sandbox now reproduces the bytecode repeat bug: source gives 6/6
suspensions, bytecode gives 4/6. Bug is in bytecode compilation of
when/do across perform boundaries, not the runtime wrapper.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-08 20:56:54 +00:00
parent c521ff8731
commit 520424954b
2 changed files with 103 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -107,7 +107,9 @@ let register_mcp_jit_hook () =
if !(Sx_vm._jit_compiling) then None
else
(try Some (Sx_vm.call_closure_reuse cl args)
with e ->
with
| Sx_vm.VmSuspended _ as e -> raise e (* let Fix 1 in jit_try_call handle it *)
| e ->
if not (Hashtbl.mem _jit_warned fn_name) then begin
Hashtbl.replace _jit_warned fn_name true;
Printf.eprintf "[mcp-jit] %s runtime fallback to CEK: %s\n%!" fn_name (Printexc.to_string e)
@@ -124,7 +126,9 @@ let register_mcp_jit_hook () =
| Some cl ->
l.l_compiled <- Some cl;
(try Some (Sx_vm.call_closure_reuse cl args)
with e ->
with
| Sx_vm.VmSuspended _ as e -> raise e
| e ->
Printf.eprintf "[mcp-jit] %s first-call fallback: %s\n%!" fn_name (Printexc.to_string e);
Hashtbl.replace _jit_warned fn_name true;
l.l_compiled <- Some Sx_vm.jit_failed_sentinel;
@@ -1572,6 +1576,10 @@ let handle_sx_playwright args =
let island = args |> member "island" |> to_string_option in
let phase = args |> member "phase" |> to_string_option in
let filter = args |> member "filter" |> to_string_option in
let setup = args |> member "setup" |> to_string_option in
let stack = args |> member "stack" |> to_string_option in
let bytecode = try args |> member "bytecode" |> to_bool with _ -> false in
let files_json = try args |> member "files" with _ -> `Null in
(* Determine whether to run specs or the inspector *)
let use_inspector = match mode with
| Some m when m <> "run" -> true
@@ -1631,6 +1639,12 @@ let handle_sx_playwright args =
(match island with Some i -> Some ("island", `String i) | None -> None);
(match phase with Some p -> Some ("phase", `String p) | None -> None);
(match filter with Some f -> Some ("filter", `String f) | None -> None);
(match setup with Some s -> Some ("setup", `String s) | None -> None);
(match stack with Some s -> Some ("stack", `String s) | None -> None);
(if bytecode then Some ("bytecode", `Bool true) else None);
(match files_json with
| `List items -> Some ("files", `List (List.map (fun j -> `String (Yojson.Safe.Util.to_string j)) items))
| _ -> None);
]) in
let args_json = Yojson.Basic.to_string inspector_args in
(* Single-quote shell wrapping — escape any literal single quotes in JSON *)
@@ -1690,10 +1704,26 @@ let handle_sx_harness_eval args =
let session = Sx_ref.cek_call (env_get e "make-harness") mock_arg in
(* Install interceptors *)
ignore (call_sx "install-interceptors" [session; Env e]);
(* IO-aware eval: drives cek_step_loop + cek_resume to handle perform *)
let io_log = ref [] in
let eval_with_io expr =
let state = Sx_ref.make_cek_state expr (Env e) (List []) in
let rec drive st =
let final = Sx_ref.cek_step_loop st in
match Sx_ref.cek_suspended_p final with
| Bool true ->
let request = Sx_runtime.get_val final (String "request") in
io_log := request :: !io_log;
let resumed = Sx_ref.cek_resume final Nil in
drive resumed
| _ -> Sx_ref.cek_value final
in
drive state
in
(* Evaluate the expression *)
let exprs = Sx_parser.parse_all expr_str in
let result = List.fold_left (fun _acc expr ->
try Sx_ref.eval_expr expr (Env e)
try eval_with_io expr
with exn -> String (Printf.sprintf "Error: %s" (Printexc.to_string exn))
) Nil exprs in
(* Get the IO log *)
@@ -1705,7 +1735,13 @@ let handle_sx_harness_eval args =
let args_val = call_sx "get" [entry; String "args"] in
Printf.sprintf " %s(%s)" op (Sx_types.inspect args_val)
) items)
| _ -> "\n\n(no IO calls)"
| _ ->
if !io_log <> [] then
"\n\nIO suspensions (" ^ string_of_int (List.length !io_log) ^ "):\n" ^
String.concat "\n" (List.rev_map (fun req ->
" (perform " ^ Sx_types.inspect req ^ ")"
) !io_log)
else "\n\n(no IO calls)"
in
let warn_str = if !warnings = [] then "" else
"\n\nWarnings:\n" ^ String.concat "\n" (List.rev !warnings)
@@ -2767,14 +2803,18 @@ let tool_definitions = `List [
[];
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), trace-boot (full console capture during boot — ALL prefixes), hydrate-debug (re-run island hydration with full env/state tracing), eval-at (inject eval at a specific boot phase)."
[("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, listeners, trace, cdp, trace-boot, hydrate-debug, eval-at")]);
("mode", `Assoc [("type", `String "string"); ("description", `String "Mode: run, inspect, diff, hydrate, eval, interact, screenshot, listeners, trace, cdp, trace-boot, hydrate-debug, eval-at, sandbox (offline WASM kernel — no server needed)")]);
("phase", `Assoc [("type", `String "string"); ("description", `String "Boot phase for eval-at mode: before-modules, after-modules, before-pages, after-pages, before-components, after-components, before-hydrate, after-hydrate, after-boot")]);
("filter", `Assoc [("type", `String "string"); ("description", `String "Filter prefix for trace-boot mode (e.g. '[sx-platform]')")]);
("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 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")])]
("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")]);
("files", `Assoc [("type", `String "array"); ("items", `Assoc [("type", `String "string")]); ("description", `String ".sx files to load (sandbox mode)")]);
("setup", `Assoc [("type", `String "string"); ("description", `String "SX setup expression (sandbox mode)")]);
("stack", `Assoc [("type", `String "string"); ("description", `String "Module stack for sandbox: core (default), web (full web stack), hs (web + hyperscript), test (web + test framework)")]);
("bytecode", `Assoc [("type", `String "boolean"); ("description", `String "Load .sxbc bytecode instead of .sx source in sandbox (default: false)")])]
[];
]