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

Fix JIT closure isolation, SX wire format, server diagnostics

Browse Source 
Root cause: _env_bind_hook mirrored ALL env_bind calls (including
lambda parameter bindings) to the shared VM globals table. Factory
functions like make-page-fn that return closures capturing different
values for the same param names (default-name, prefix, suffix) would
have the last call's values overwrite all previous closures' captured
state in globals. OP_GLOBAL_GET reads globals first, so all closures
returned the last factory call's values.

Fix: only sync root-env bindings (parent=None) to VM globals. Lambda
parameter bindings stay in their local env, found via vm_closure_env
fallback in OP_GLOBAL_GET.

Also in this commit:
- OP_CLOSURE propagates parent vm_closure_env to child closures
- Remove JIT globals injection (closure vars found via env chain)
- sx_server.ml: SX-Request header → returns text/sx (aser only)
- sx_server.ml: diagnostic endpoint GET /sx/_debug/{env,eval,route}
- sx_server.ml: page helper stubs for deep page rendering
- sx_server.ml: skip client-libs/ dir (browser-only definitions)
- adapter-html.sx: unknown components → HTML comment (not error)
- sx-platform.js: .sxbc fallback loader for bytecode modules
- Delete sx_http.ml (standalone HTTP server, unused)
- Delete stale .sxbc.json files (arity=0 bug, replaced by .sxbc)
- 7 new closure isolation tests in test-closure-isolation.sx
- mcp_tree.ml: emit arity + upvalue-count in .sxbc.json output

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-30 17:28:47 +00:00
parent 408eca1cb0
commit 80931e4972
43 changed files with 1528 additions and 1268 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
hosts/ocaml/bin/sx_server.ml
View File

@@ -669,11 +669,13 @@ let _shared_vm_globals : (string, Sx_types.value) Hashtbl.t = Hashtbl.create 204
let env_to_vm_globals _env = _shared_vm_globals
let () =
(* Hook env_bind globally so EVERY binding (from make_server_env, file loads,
component defs, shell statics, etc.) is mirrored to vm globals.
This eliminates the snapshot-staleness problem entirely. *)
Sx_types._env_bind_hook := Some (fun _env name v ->
Hashtbl.replace _shared_vm_globals name v)
(* Hook env_bind so top-level bindings (defines, component defs, shell statics)
are mirrored to vm globals. Only sync when binding in a root env (no parent)
to avoid polluting globals with lambda parameter bindings, which would break
closure isolation for factory functions like make-page-fn. *)
Sx_types._env_bind_hook := Some (fun env name v ->
if env.parent = None then
Hashtbl.replace _shared_vm_globals name v)
let make_server_env () =
let env = make_env () in
@@ -1552,23 +1554,15 @@ let http_render_page env path headers =
else begin
let wrapped = List [Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast] in
if is_ajax then begin
(* AJAX: render content fragment only — no shell *)
(* AJAX: return SX wire format (aser output) with text/sx content type *)
let body_result =
let call = List [Symbol "aser"; List [Symbol "quote"; wrapped]; Env env] in
Sx_ref.eval_expr call (Env env) in
let body_str = match body_result with
| String s | SxExpr s -> s | _ -> serialize_value body_result in
let body_html = try
let body_expr = match Sx_parser.parse_all body_str with
| [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; body_expr]; Env env] in
(match Sx_ref.eval_expr render_call (Env env) with
| String s | RawHTML s -> s | v -> Sx_runtime.value_to_str v)
with e -> Printf.eprintf "[http-ajax] ssr error: %s\n%!" (Printexc.to_string e); "" in
let t1 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] %s AJAX %.3fs html=%d\n%!" path (t1 -. t0) (String.length body_html);
Some body_html
Printf.eprintf "[sx-http] %s (SX) aser=%.3fs body=%d\n%!" path (t1 -. t0) (String.length body_str);
Some body_str
end else begin
(* Full page: aser → SSR → shell *)
let full_ast = List [Symbol "~shared:layout/app-body"; Keyword "content"; wrapped] in
@@ -1894,7 +1888,8 @@ let http_load_files env files =
rebind_host_extensions env
let http_setup_page_helpers env =
(* Page helpers that Python normally provides. Minimal stubs for HTTP mode. *)
(* Page helpers that Python normally provides. Minimal stubs for HTTP mode.
These return empty/nil so pages render without hanging. *)
let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
(* highlight — passthrough without syntax coloring *)
bind "highlight" (fun args ->
@@ -1903,8 +1898,33 @@ let http_setup_page_helpers env =
let escaped = escape_sx_string code in
SxExpr (Printf.sprintf "(pre :class \"text-sm overflow-x-auto\" (code \"%s\"))" escaped)
| _ -> Nil);
(* component-source — stub *)
bind "component-source" (fun _args -> String "")
(* Stub all Python page helpers with nil/empty returns *)
let stub name = bind name (fun _args -> Nil) in
let stub_s name = bind name (fun _args -> String "") in
stub_s "component-source";
stub_s "handler-source";
stub "primitives-data";
stub "special-forms-data";
stub "reference-data";
stub "attr-detail-data";
stub "header-detail-data";
stub "event-detail-data";
stub_s "read-spec-file";
stub "bootstrapper-data";
stub "bundle-analyzer-data";
stub "routing-analyzer-data";
stub "data-test-data";
stub "run-spec-tests";
stub "run-modular-tests";
stub "streaming-demo-data";
stub "affinity-demo-data";
stub "optimistic-demo-data";
stub "action:add-demo-item";
stub "offline-demo-data";
stub "prove-data";
stub "page-helpers-demo-data";
stub "spec-explorer-data";
stub "spec-explorer-data-by-slug"
let http_mode port =
let env = make_server_env () in
@@ -1953,7 +1973,7 @@ let http_mode port =
(* Files to skip — declarative metadata, not needed for rendering *)
let skip_files = ["primitives.sx"; "types.sx"; "boundary.sx";
"harness.sx"; "eval-rules.sx"; "vm-inline.sx"] in
let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"] in
let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"; "client-libs"] in
let rec load_dir dir =
if Sys.file_exists dir && Sys.is_directory dir then begin
let entries = Sys.readdir dir in
@@ -2132,12 +2152,15 @@ let http_mode port =
in
match work with
| Some (fd, path, headers) ->
let cache_key = if headers <> [] then "ajax:" ^ path else path in
let is_ajax = headers <> [] in
let cache_key = if is_ajax then "ajax:" ^ path else path in
let response =
try
match http_render_page env path headers with
| Some html ->
let resp = http_response html in
| Some body ->
let ct = if is_ajax then "text/sx; charset=utf-8"
else "text/html; charset=utf-8" in
let resp = http_response ~content_type:ct body in
Hashtbl.replace response_cache cache_key resp;
resp
| None -> http_response ~status:404 "<h1>Not Found</h1>"
@@ -2163,6 +2186,51 @@ let http_mode port =
if path = "/" then begin
write_response fd (http_redirect "/sx/"); true
end else
(* Debug endpoint — runs on main thread, no render worker *)
if String.length path > 11 && String.sub path 0 11 = "/sx/_debug/" then begin
let cmd = String.sub path 11 (String.length path - 11) in
let query_start = try String.index cmd '?' with Not_found -> String.length cmd in
let action = String.sub cmd 0 query_start in
let query = if query_start < String.length cmd - 1
then String.sub cmd (query_start + 1) (String.length cmd - query_start - 1)
else "" in
let get_param key =
let prefix = key ^ "=" in
let parts = String.split_on_char '&' query in
match List.find_opt (fun p -> String.length p >= String.length prefix
&& String.sub p 0 (String.length prefix) = prefix) parts with
| Some p -> url_decode (String.sub p (String.length prefix) (String.length p - String.length prefix))
| None -> "" in
let result = match action with
| "env" ->
let name = get_param "name" in
(try
let v = env_get env name in
Printf.sprintf "%s = %s\n" name (Sx_runtime.value_to_str (Sx_runtime.type_of v))
with _ -> Printf.sprintf "%s = UNDEFINED\n" name)
| "eval" ->
let expr_s = get_param "expr" in
(try
let exprs = Sx_parser.parse_all expr_s in
let result = List.fold_left (fun _ e -> Sx_ref.eval_expr e (Env env)) Nil exprs in
Sx_runtime.value_to_str result ^ "\n"
with e -> Printf.sprintf "ERROR: %s\n" (Printexc.to_string e))
| "route" ->
let p = get_param "path" in
(try
let handler = env_get env "sx-handle-request" in
let headers_dict = Hashtbl.create 0 in
let r = Sx_ref.cek_call handler (List [String p; Dict headers_dict; Env env; Nil]) in
match r with
| Dict d ->
let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
Printf.sprintf "page-ast: %s\n" (Sx_runtime.value_to_str page_ast)
| _ -> Printf.sprintf "route returned: %s\n" (Sx_runtime.value_to_str r)
with e -> Printf.sprintf "ERROR: %s\n" (Printexc.to_string e))
| _ -> "Unknown debug command. Try: env?name=X, eval?expr=X, route?path=X\n"
in
write_response fd (http_response ~content_type:"text/plain; charset=utf-8" result); true
end else
let is_sx = path = "/sx/" || path = "/sx"
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in
if is_sx then begin