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

2
hosts/ocaml/bin/dune
View File

@@ -1,5 +1,5 @@
(executables
(names run_tests debug_set sx_server sx_http integration_tests)
(names run_tests debug_set sx_server integration_tests)
(libraries sx unix))
(executable

518
hosts/ocaml/bin/sx_http.ml
View File

@@ -1,518 +0,0 @@
(** SX HTTP server — serves sx-docs directly from OCaml, no Python bridge.
Replaces: Quart + Hypercorn + ocaml_bridge.py + sx_router.py
Keeps: Caddy (TLS termination, static files, reverse proxy)
Usage:
sx_http.exe [--port 8013] [--static /path/to/shared/static]
Architecture:
1. At startup: load all .sx components, pre-compute shell statics
2. Per request: parse HTTP GET → route → eval page → render HTML
3. No Python, no bridge, no serialization boundaries *)
open Sx_types
(* ====================================================================== *)
(* Reuse sx_server infrastructure *)
(* ====================================================================== *)
(* Import make_server_env and rendering from sx_server.
We can't directly share because OCaml doesn't support cross-executable
linking. Instead, we duplicate the minimal setup and reuse library fns. *)
let escape_sx_string s =
let buf = Buffer.create (String.length s + 16) in
String.iter (function
| '"' -> Buffer.add_string buf "\\\""
| '\\' -> Buffer.add_string buf "\\\\"
| '\n' -> Buffer.add_string buf "\\n"
| '\r' -> Buffer.add_string buf "\\r"
| '\t' -> Buffer.add_string buf "\\t"
| c -> Buffer.add_char buf c) s;
Buffer.contents buf
let rec serialize_value = function
| Nil -> "nil"
| Bool true -> "true"
| Bool false -> "false"
| Number n ->
if Float.is_integer n then string_of_int (int_of_float n)
else Printf.sprintf "%g" n
| String s -> "\"" ^ escape_sx_string s ^ "\""
| Symbol s -> s
| Keyword k -> ":" ^ k
| List items | ListRef { contents = items } ->
"(" ^ String.concat " " (List.map serialize_value items) ^ ")"
| Dict d ->
let pairs = Hashtbl.fold (fun k v acc ->
(Printf.sprintf ":%s %s" k (serialize_value v)) :: acc) d [] in
"{" ^ String.concat " " pairs ^ "}"
| RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
| SxExpr s -> s
| _ -> "nil"
(* ====================================================================== *)
(* Environment setup — mirrors make_server_env from sx_server.ml *)
(* ====================================================================== *)
(* IO bridge stubs — sx-docs has no IO callbacks, but the evaluator
expects these symbols to exist. We stub them to raise clear errors. *)
let setup_io_stubs env =
let stub name =
ignore (env_bind env name (NativeFn (name, fun _args ->
raise (Eval_error (Printf.sprintf "IO primitive '%s' not available in sx_http" name)))))
in
stub "io-request";
stub "helper";
(* query/action/service: not needed for sx-docs *)
stub "query";
stub "action";
stub "service"
let make_http_env () =
let env = make_env () in
Sx_render.setup_render_env env;
(* Scope primitives — inline since Sx_scope was merged *)
let _scope_stacks : (string, Sx_types.value list) Hashtbl.t = Hashtbl.create 8 in
let bind name fn = ignore (Sx_types.env_bind env name (Sx_types.NativeFn (name, fn))) in
bind "scope-push!" (fun args -> match args with
| [String name; value] -> let s = try Hashtbl.find _scope_stacks name with Not_found -> [] in Hashtbl.replace _scope_stacks name (value :: s); Nil
| [String name] -> let s = try Hashtbl.find _scope_stacks name with Not_found -> [] in Hashtbl.replace _scope_stacks name (Nil :: s); Nil
| _ -> Nil);
bind "scope-pop!" (fun args -> match args with
| [String name] -> (match (try Hashtbl.find _scope_stacks name with Not_found -> []) with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
| _ -> Nil);
bind "scope-peek" (fun args -> match args with
| [String name] -> (match (try Hashtbl.find _scope_stacks name with Not_found -> []) with v :: _ -> v | [] -> Nil)
| _ -> Nil);
bind "scope-emit!" (fun args -> match args with
| [String name; value] ->
let key = name ^ ":emitted" in
let s = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key (value :: s); Nil
| _ -> Nil);
bind "scope-emitted" (fun args -> match args with
| [String name] ->
let key = name ^ ":emitted" in
let items = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key []; List (List.rev items)
| _ -> List []);
bind "collect!" (fun args -> match args with
| [String name; value] ->
let key = name ^ ":collected" in
let s = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key (value :: s); Nil
| _ -> Nil);
bind "collected" (fun args -> match args with
| [String name] ->
let key = name ^ ":collected" in
let items = try Hashtbl.find _scope_stacks key with Not_found -> [] in
Hashtbl.replace _scope_stacks key []; List (List.rev items)
| _ -> List []);
(* Declarative form stubs — no-ops at runtime *)
bind "define-module" (fun _args -> Nil);
bind "define-primitive" (fun _args -> Nil);
bind "deftype" (fun _args -> Nil);
bind "defeffect" (fun _args -> Nil);
bind "deftest" (fun _args -> Nil);
bind "defstyle" (fun _args -> Nil);
bind "defhandler" (fun _args -> Nil);
bind "defpage" (fun _args -> Nil);
bind "defquery" (fun _args -> Nil);
bind "defaction" (fun _args -> Nil);
bind "defrelation" (fun _args -> Nil);
(* Render stubs *)
bind "set-render-active!" (fun _args -> Nil);
bind "render-active?" (fun _args -> Bool true);
bind "trampoline" (fun args -> match args with
| [Thunk (expr, e)] -> Sx_ref.eval_expr expr (Env e)
| [v] -> v | _ -> Nil);
(* Setup all the standard primitives *)
(* Evaluator bridge — needed for aser, macro expansion *)
ignore (env_bind env "eval-expr" (NativeFn ("eval-expr", fun args ->
match args with
| [expr; Env e] -> Sx_ref.eval_expr expr (Env e)
| [expr] -> Sx_ref.eval_expr expr (Env env)
| _ -> Nil)));
ignore (env_bind env "apply" (NativeFn ("apply", fun args ->
match args with
| [f; List a] -> Sx_ref.cek_call f (List a)
| _ -> Nil)));
ignore (env_bind env "macroexpand-1" (NativeFn ("macroexpand-1", fun args ->
match args with
| [expr; Env e] ->
(try Sx_ref.eval_expr (List [Symbol "macroexpand-1-impl"; List [Symbol "quote"; expr]]) (Env e)
with _ -> expr)
| _ -> Nil)));
(* Trampoline for HO primitives *)
Sx_primitives._sx_trampoline_fn := (fun v ->
match v with
| Thunk (body, closure_env) -> Sx_ref.eval_expr body (Env closure_env)
| other -> other);
(* client? = false on server *)
ignore (env_bind env "client?" (NativeFn ("client?", fun _ -> Bool false)));
(* IO stubs *)
setup_io_stubs env;
(* Component introspection *)
ignore (env_bind env "component-name" (NativeFn ("component-name", fun args ->
match args with [Component c] -> String c.c_name | [Island i] -> String i.i_name | _ -> Nil)));
ignore (env_bind env "component-params" (NativeFn ("component-params", fun args ->
match args with
| [Component c] -> List (List.map (fun s -> Symbol s) c.c_params)
| [Island i] -> List (List.map (fun s -> Symbol s) i.i_params)
| _ -> Nil)));
ignore (env_bind env "component-body" (NativeFn ("component-body", fun args ->
match args with [Component c] -> c.c_body | [Island i] -> i.i_body | _ -> Nil)));
ignore (env_bind env "component-has-children?" (NativeFn ("component-has-children?", fun args ->
match args with [Component c] -> Bool c.c_has_children | [Island i] -> Bool i.i_has_children | _ -> Bool false)));
ignore (env_bind env "component-affinity" (NativeFn ("component-affinity", fun args ->
match args with [Component c] -> String c.c_affinity | [Island _] -> String "client" | _ -> String "auto")));
(* Spread attrs *)
ignore (env_bind env "spread-attrs" (NativeFn ("spread-attrs", fun args ->
match args with [Spread pairs] ->
let d = Hashtbl.create 8 in
List.iter (fun (k, v) -> Hashtbl.replace d k v) pairs; Dict d
| _ -> Nil)));
env
(* ====================================================================== *)
(* File loading *)
(* ====================================================================== *)
let load_file env path =
try
let src = In_channel.with_open_text path In_channel.input_all in
let exprs = Sx_parser.parse_all src in
List.iter (fun expr ->
try ignore (Sx_ref.eval_expr expr (Env env))
with e -> Printf.eprintf "[load] %s: %s\n%!" path (Printexc.to_string e)
) exprs;
Printf.eprintf "[load] %s (%d forms)\n%!" path (List.length exprs)
with e ->
Printf.eprintf "[load] failed %s: %s\n%!" path (Printexc.to_string e)
let load_dir env dir pattern =
if Sys.file_exists dir && Sys.is_directory dir then
Array.iter (fun f ->
if Filename.check_suffix f pattern then
load_file env (dir ^ "/" ^ f)
) (Sys.readdir dir)
let load_all_components env project_dir =
let spec = project_dir ^ "/spec" in
let lib = project_dir ^ "/lib" in
let web = project_dir ^ "/web" in
let shared_sx = project_dir ^ "/shared/sx/templates" in
let sx_sx = project_dir ^ "/sx/sx" in
(* Core spec *)
List.iter (fun f -> load_file env (spec ^ "/" ^ f)) [
"parser.sx"; "primitives.sx"; "render.sx"; "evaluator.sx";
];
(* Libraries *)
load_dir env lib ".sx";
(* Web adapters *)
load_dir env web ".sx";
(* Shared templates *)
load_dir env shared_sx ".sx";
(* SX docs components *)
load_dir env sx_sx ".sx"
(* ====================================================================== *)
(* Shell statics — computed once at startup *)
(* ====================================================================== *)
type shell_static = {
component_defs: string;
component_hash: string;
pages_sx: string;
sx_css: string;
asset_url: string;
}
let compute_shell_statics env _project_dir =
(* Serialize all components for client *)
let buf = Buffer.create 65536 in
Hashtbl.iter (fun _sym v ->
match v with
| Component c ->
let ps = String.concat " " (
"&key" :: c.c_params @
(if c.c_has_children then ["&rest"; "children"] else []))
in
Buffer.add_string buf (Printf.sprintf "(defcomp ~%s (%s) %s)\n"
c.c_name ps (serialize_value c.c_body))
| Island i ->
let ps = String.concat " " (
"&key" :: i.i_params @
(if i.i_has_children then ["&rest"; "children"] else []))
in
Buffer.add_string buf (Printf.sprintf "(defisland ~%s (%s) %s)\n"
i.i_name ps (serialize_value i.i_body))
| _ -> ()
) env.bindings;
let component_defs = Buffer.contents buf in
let component_hash = Digest.string component_defs |> Digest.to_hex in
(* Pages SX — collect defpage paths for client router *)
(* For now, empty — client routing uses the pages script tag *)
let pages_sx = "" in
(* CSS — for now pass through empty, Caddy serves tw.css *)
let sx_css = "" in
{
component_defs;
component_hash;
pages_sx;
sx_css;
asset_url = "/static";
}
(* ====================================================================== *)
(* HTML rendering — same as sx_server.ml *)
(* ====================================================================== *)
let sx_render_to_html expr env =
if env_has env "render-to-html" then
let fn = env_get env "render-to-html" in
let result = Sx_ref.cek_call fn (List [expr; Env env]) in
match result with String s -> s | _ -> Sx_runtime.value_to_str result
else
Sx_render.sx_render_to_html env expr env
(* ====================================================================== *)
(* Page rendering — aser + SSR + shell in one pass *)
(* ====================================================================== *)
let render_page env statics path =
let t0 = Unix.gettimeofday () in
(* Build the page AST: evaluate the URL path as an SX expression *)
let path_expr = if path = "/" || path = "" || path = "/sx/" || path = "/sx" then "home"
else begin
(* /sx/(geography.(reactive)) → (geography (reactive)) *)
let p = if String.length path > 4 && String.sub path 0 4 = "/sx/" then
String.sub path 4 (String.length path - 4)
else if String.length path > 1 && path.[0] = '/' then
String.sub path 1 (String.length path - 1)
else path
in
(* Convert dots to spaces for SX URL convention *)
String.map (fun c -> if c = '.' then ' ' else c) p
end
in
(* Evaluate page function to get component call *)
let page_ast =
try
let exprs = Sx_parser.parse_all path_expr in
let expr = match exprs with [e] -> e | _ -> List (List.map Fun.id exprs) in
Sx_ref.eval_expr expr (Env env)
with e ->
Printf.eprintf "[route] eval failed for '%s': %s\n%!" path_expr (Printexc.to_string e);
Nil
in
if page_ast = Nil then None
else begin
(* Wrap in layout: (~layouts/doc :path "/sx/..." page_ast) *)
let nav_path = if String.sub path 0 4 = "/sx/" then path
else "/sx" ^ path in
let wrapped = List [
Symbol "~layouts/doc"; Keyword "path"; String nav_path;
page_ast
] in
(* Wrap in app-body *)
let full_ast = List [
Symbol "~shared:layout/app-body";
Keyword "content"; wrapped
] in
let page_source = serialize_value full_ast in
let t1 = Unix.gettimeofday () in
(* Phase 1: aser — expand all components *)
let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
ignore (env_bind env "expand-components?" expand_fn);
let body_result =
let call = List [Symbol "aser";
List [Symbol "quote"; full_ast];
Env env] in
Sx_ref.eval_expr call (Env env)
in
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
in
let t2 = Unix.gettimeofday () in
(* Phase 2: SSR — render expanded SX to HTML *)
let body_html =
try
let body_exprs = Sx_parser.parse_all body_str in
let body_expr = match body_exprs with
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs) in
sx_render_to_html body_expr env
with e ->
Printf.eprintf "[ssr] render-to-html failed: %s\n%!" (Printexc.to_string e);
""
in
let t3 = Unix.gettimeofday () in
(* Phase 3: Shell — wrap in full HTML page *)
let shell_args = [
Keyword "title"; String "SX";
Keyword "csrf"; String "";
Keyword "page-sx"; String page_source;
Keyword "body-html"; String body_html;
Keyword "component-defs"; String statics.component_defs;
Keyword "component-hash"; String statics.component_hash;
Keyword "pages-sx"; String statics.pages_sx;
Keyword "sx-css"; String statics.sx_css;
Keyword "sx-css-classes"; String "";
Keyword "asset-url"; String statics.asset_url;
Keyword "sx-js-hash"; String "";
Keyword "body-js-hash"; String "";
Keyword "wasm-hash"; String "";
Keyword "head-scripts"; Nil;
Keyword "body-scripts"; Nil;
Keyword "inline-css"; Nil;
Keyword "inline-head-js"; Nil;
Keyword "init-sx"; Nil;
Keyword "use-wasm"; Bool (try Sys.getenv "SX_USE_WASM" = "1" with Not_found -> false);
Keyword "meta-html"; String "";
] in
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
let html = sx_render_to_html shell_call env in
let t4 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] %s route=%.3fs aser=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs html=%d\n%!"
path (t1 -. t0) (t2 -. t1) (t3 -. t2) (t4 -. t3) (t4 -. t0) (String.length html);
Some html
end
(* ====================================================================== *)
(* HTTP server *)
(* ====================================================================== *)
let http_response ?(status=200) ?(content_type="text/html; charset=utf-8") body =
let status_text = match status with
| 200 -> "OK" | 404 -> "Not Found" | 500 -> "Internal Server Error"
| _ -> "Unknown"
in
Printf.sprintf "HTTP/1.1 %d %s\r\nContent-Type: %s\r\nContent-Length: %d\r\nConnection: keep-alive\r\n\r\n%s"
status status_text content_type (String.length body) body
let parse_request data =
(* Extract method and path from "GET /path HTTP/1.1\r\n..." *)
match String.split_on_char ' ' (String.trim (
match String.index_opt data '\r' with
| Some i -> String.sub data 0 i
| None -> match String.index_opt data '\n' with
| Some i -> String.sub data 0 i
| None -> data
)) with
| method_ :: path :: _ -> Some (method_, path)
| _ -> None
let handle_request env statics data =
match parse_request data with
| None -> http_response ~status:400 "Bad Request"
| Some (method_, path) ->
if method_ <> "GET" then
http_response ~status:405 "Method Not Allowed"
else begin
let decoded = try
let b = Buffer.create (String.length path) in
let i = ref 0 in
while !i < String.length path do
if path.[!i] = '%' && !i + 2 < String.length path then begin
let hex = String.sub path (!i + 1) 2 in
Buffer.add_char b (Char.chr (int_of_string ("0x" ^ hex)));
i := !i + 3
end else begin
Buffer.add_char b path.[!i];
i := !i + 1
end
done;
Buffer.contents b
with _ -> path
in
(* Route: /sx/... or / → page render *)
let is_sx_path = String.length decoded >= 4 && String.sub decoded 0 4 = "/sx/" in
let is_home = decoded = "/" || decoded = "/sx/" in
if is_home || is_sx_path then
match render_page env statics decoded with
| Some html -> http_response html
| None -> http_response ~status:404 "<h1>404 Not Found</h1>"
else
http_response ~status:404 "<h1>404 Not Found</h1>"
end
let serve env statics port =
let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
Unix.setsockopt sock Unix.SO_REUSEADDR true;
Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_any, port));
Unix.listen sock 128;
Printf.eprintf "[sx-http] Listening on port %d\n%!" port;
while true do
let (client, _addr) = Unix.accept sock in
(* Read request — simple: read up to 8KB, enough for any GET *)
let buf = Bytes.create 8192 in
let n = try Unix.read client buf 0 8192 with _ -> 0 in
if n > 0 then begin
let data = Bytes.sub_string buf 0 n in
let response =
try handle_request env statics data
with e ->
Printf.eprintf "[sx-http] Error: %s\n%!" (Printexc.to_string e);
http_response ~status:500 "<h1>500 Internal Server Error</h1>"
in
let resp_bytes = Bytes.of_string response in
let total = Bytes.length resp_bytes in
let written = ref 0 in
while !written < total do
let n = Unix.write client resp_bytes !written (total - !written) in
written := !written + n
done
end;
Unix.close client
done
(* ====================================================================== *)
(* Main *)
(* ====================================================================== *)
let () =
let port = ref 8014 in
let project_dir = ref (try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
try Sys.getenv "SX_ROOT" with Not_found ->
if Sys.file_exists "/app/spec" then "/app"
else Sys.getcwd ()) in
(* Parse args *)
let args = Array.to_list Sys.argv in
let rec parse = function
| "--port" :: p :: rest -> port := int_of_string p; parse rest
| "--project" :: d :: rest -> project_dir := d; parse rest
| _ :: rest -> parse rest
| [] -> ()
in
parse (List.tl args);
Printf.eprintf "[sx-http] project_dir=%s\n%!" !project_dir;
(* Build environment *)
let env = make_http_env () in
(* Load all components *)
let t0 = Unix.gettimeofday () in
load_all_components env !project_dir;
let t1 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] Components loaded in %.3fs\n%!" (t1 -. t0);
(* Compute shell statics *)
let statics = compute_shell_statics env !project_dir in
let t2 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] Shell statics computed in %.3fs (defs=%d hash=%s)\n%!"
(t2 -. t1) (String.length statics.component_defs) statics.component_hash;
(* Start HTTP server *)
serve env statics !port

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

37
hosts/ocaml/lib/sx_vm.ml
View File

@@ -371,7 +371,7 @@ and run vm =
frame.closure.vm_upvalues.(index)
) in
let cl = { vm_code = code; vm_upvalues = upvalues; vm_name = None;
vm_env_ref = vm.globals; vm_closure_env = None } in
vm_env_ref = vm.globals; vm_closure_env = frame.closure.vm_closure_env } in
push vm (VmClosure cl)
| 52 (* OP_CALL_PRIM *) ->
let idx = read_u16 frame in
@@ -578,32 +578,13 @@ let jit_compile_lambda (l : lambda) globals =
let fn_expr = List [Symbol "fn"; param_syms; l.l_body] in
let quoted = List [Symbol "quote"; fn_expr] in
let result = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env (make_env ())) in
(* If the lambda has closure-captured variables, merge them into globals
so the VM can find them via GLOBAL_GET. The compiler doesn't know
about the enclosing scope, so closure vars get compiled as globals. *)
let effective_globals =
(* Use the LIVE globals table directly. Inject only truly local
closure bindings (not already in globals) into the live table.
This ensures GLOBAL_GET always sees the latest define values.
Previous approach copied globals, creating a stale snapshot. *)
let closure = l.l_closure in
let count = ref 0 in
let rec inject env =
Hashtbl.iter (fun id v ->
let name = Sx_types.unintern id in
if not (Hashtbl.mem globals name) then begin
Hashtbl.replace globals name v;
incr count
end
) env.bindings;
match env.parent with Some p -> inject p | None -> ()
in
if Hashtbl.length closure.bindings > 0 || closure.parent <> None then
inject closure;
if !count > 0 then
Printf.eprintf "[jit] %s: injected %d closure bindings\n%!" fn_name !count;
globals
in
(* Closure vars are accessible via vm_closure_env (set on the VmClosure
at line ~617). OP_GLOBAL_GET falls back to vm_closure_env when vars
aren't in globals. No injection into the shared globals table —
that would break closure isolation for factory functions like
make-page-fn where multiple closures capture different values
for the same variable names. *)
let effective_globals = globals in
(match result with
| Dict d when Hashtbl.mem d "bytecode" ->
let outer_code = code_from_value result in
@@ -798,7 +779,7 @@ let trace_run src globals =
) in
let inner_code = code_from_value code_val2 in
let c = { vm_code = inner_code; vm_upvalues = upvalues; vm_name = None;
vm_env_ref = vm.globals; vm_closure_env = None } in
vm_env_ref = vm.globals; vm_closure_env = frame.closure.vm_closure_env } in
push vm (VmClosure c)
| 52 -> let idx = read_u16 frame in let argc = read_u8 frame in
let name = match frame.closure.vm_code.vc_constants.(idx) with String s -> s | _ -> "" in