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

Fix JIT mutable closure bug: vm-global-get now checks closure env first

Browse Source 
vm-global-get checked vm.globals before closure-env, while vm-global-set
wrote to closure-env first. This asymmetry meant set! mutations to mutable
closure variables (e.g. parser position counters) were invisible to sibling
closures reading via JIT — they saw stale snapshots in the globals table.

Reversed vm-global-get lookup order: closure env → globals → primitives,
matching vm-global-set. Also enabled JIT in the MCP harness (compiler.sx
loading, env_bind hook for live globals sync, jit_try_call hook) so
sx_harness_eval exercises the same code path as the server.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-06 12:08:08 +00:00
parent 022c4f7f26
commit 3a9d113537
2 changed files with 68 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -27,6 +27,48 @@ let load_sx_file e path =
ignore (Sx_ref.eval_expr expr (Env e))
) exprs
(* JIT infrastructure — shared VM globals table, kept in sync via env_bind hook *)
let _mcp_vm_globals : (string, value) Hashtbl.t = Hashtbl.create 2048
let _jit_compiling = ref false
let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 32
let register_mcp_jit_hook () =
Sx_runtime._jit_try_call_fn := Some (fun f args ->
match f with
| Lambda l ->
(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)
with e ->
let fn_name = match l.l_name with Some n -> n | None -> "?" in
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)
end;
None)
| Some _ -> None
| None ->
if !_jit_compiling then None
else begin
let fn_name = match l.l_name with Some n -> n | None -> "?" in
if Hashtbl.mem _jit_warned fn_name then None
else begin
_jit_compiling := true;
let compiled = Sx_vm.jit_compile_lambda l _mcp_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)
with e ->
Printf.eprintf "[mcp-jit] %s first-call fallback: %s\n%!" fn_name (Printexc.to_string e);
Hashtbl.replace _jit_warned fn_name true;
None)
| None -> None
end
end)
| _ -> None)
let setup_env () =
let e = make_env () in
(* Primitives are auto-registered at module init *)
@@ -35,6 +77,11 @@ let setup_env () =
match v with
| Thunk (body, closure_env) -> Sx_ref.eval_expr body (Env closure_env)
| other -> other);
(* JIT: mirror root-env bindings into shared VM globals table *)
Sx_types._env_bind_hook := Some (fun env name v ->
if env.parent = None then
if not (Sx_primitives.is_primitive name) then
Hashtbl.replace _mcp_vm_globals name v);
(* Character classification for parser *)
let bind name fn = ignore (env_bind e name (NativeFn (name, fn))) in
bind "is-whitespace?" (fun args -> match args with
@@ -296,6 +343,11 @@ let setup_env () =
(NativeFn ("html:" ^ tag, fun args -> List (Symbol tag :: args))))
) Sx_render.html_tags;
ignore (Sx_types.env_bind e "island?" (NativeFn ("island?", fun args -> match args with [Island _] -> Bool true | _ -> Bool false)));
(* Load compiler + enable JIT *)
(try load_sx_file e (Filename.concat lib_dir "compiler.sx");
register_mcp_jit_hook ();
Printf.eprintf "[mcp] JIT enabled (compiler.sx loaded)\n%!"
with exn -> Printf.eprintf "[mcp] Warning: compiler.sx load failed (JIT disabled): %s\n%!" (Printexc.to_string exn));
Printf.eprintf "[mcp] SX tree-tools + harness + eval-rules + render loaded\n%!";
env := e