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

SX request handler + AJAX nav + shared JIT globals + shell cleanup

Browse Source 
- Remove prism.js, sweetalert2, body.js, sx-browser.js from shell —
  only WASM kernel (sx_browser.bc.wasm.js + sx-platform.js) loads
- Restore request-handler.sx integration: SX handles routing + AJAX
  detection, OCaml does aser → SSR → shell render pipeline
- AJAX fragment support: SX-Request header returns content fragment
  (~14KB) instead of full page (~858KB), cached with "ajax:" prefix
- Fix language/applications/etc page functions to return empty fragment
  instead of nil (was causing 404s)
- Shared JIT VM globals: env_bind hook mirrors ALL bindings to a single
  shared globals table — eliminates stale-snapshot class of JIT bugs
- Add native `parse` function for components that need SX parsing
- Clean up unused shell params (sx-js-hash, body-js-hash, head-scripts,
  body-scripts, use-wasm) from shell.sx, helpers.py, and server.ml

14/32 Playwright tests pass (navigation, SSR, isomorphic, geography).
Remaining failures are client-side (WASM bytecode 404s block hydration).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-30 03:03:57 +00:00
parent 847d04d4ba
commit 671d19c978
5 changed files with 246 additions and 307 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -569,6 +569,15 @@ let setup_type_constructors env =
let lo = int_of_float lo and hi = int_of_float hi in
Number (float_of_int (lo + Random.int (max 1 (hi - lo + 1))))
| _ -> raise (Eval_error "random-int: expected (low high)"));
bind "parse" (fun args ->
match args with
| [String s] | [SxExpr s] ->
let exprs = Sx_parser.parse_all s in
(match exprs with [e] -> e | _ -> List exprs)
| [v] ->
(* Already a value — return as-is *)
v
| _ -> raise (Eval_error "parse: expected string"));
bind "parse-int" (fun args ->
match args with
| [String s] -> (try Number (float_of_int (int_of_string s)) with _ -> Nil)
@@ -647,10 +656,19 @@ let setup_html_tags env =
(* ====================================================================== *)
(** 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.Sx_types.bindings) in
Hashtbl.iter (fun id v -> Hashtbl.replace g (Sx_types.unintern id) v) env.Sx_types.bindings;
g
(* Shared VM globals table — one live table, all JIT closures share
the same reference. Kept in sync via env_bind hook so late-bound
values (shell statics, page functions, defines) are always visible. *)
let _shared_vm_globals : (string, Sx_types.value) Hashtbl.t = Hashtbl.create 2048
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)
let make_server_env () =
let env = make_env () in
@@ -1462,142 +1480,123 @@ let url_decode s =
done;
Buffer.contents buf
(** Render a page from an SX URL path. Returns HTML or None. *)
let http_render_page env path =
let parse_http_headers data =
let lines = String.split_on_char '\n' data in
let headers = ref [] in
List.iter (fun line ->
let line = if String.length line > 0 && line.[String.length line - 1] = '\r'
then String.sub line 0 (String.length line - 1) else line in
match String.index_opt line ':' with
| Some i when i > 0 ->
let key = String.trim (String.sub line 0 i) in
let value = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in
headers := (key, value) :: !headers
| _ -> ()
) (match lines with _ :: rest -> rest | [] -> []);
!headers
(** Render a page. Routing + AJAX detection in SX (request-handler.sx),
render pipeline (aser → SSR → shell) in OCaml for reliable env access. *)
let http_render_page env path headers =
let t0 = Unix.gettimeofday () in
(* Parse the URL path to an SX expression *)
let path_expr =
if path = "/" || path = "/sx/" || path = "/sx" then "home"
else begin
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
(* URL convention: dots → spaces *)
String.map (fun c -> if c = '.' then ' ' else c) p
end
in
(* Auto-quote unknown symbols as strings (slug parameters).
e.g. (etc (plan sx-host)) → (etc (plan "sx-host"))
Matches Python's prepare_url_expr behavior. *)
let rec auto_quote expr =
match expr with
| Symbol s when not (env_has env s) && (try ignore (Sx_primitives.get_primitive s); false with _ -> true) ->
String s
| List items -> List (List.map auto_quote items)
| ListRef { contents = items } -> List (List.map auto_quote items)
| _ -> expr
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 exprs in
let quoted = auto_quote expr in
(* Bare symbols (like "home") → wrap in list to call as function.
e.g. home → (home), geography → (geography) *)
let callable = match quoted with
| Symbol _ -> List [quoted]
| _ -> quoted in
Sx_ref.eval_expr callable (Env env)
with e ->
Printf.eprintf "[http-route] eval failed for '%s': %s\n%!" path_expr (Printexc.to_string e);
Nil
in
if page_ast = Nil then None
else begin
(* Wrap: (~layouts/doc :path "/sx/..." content) → (~shared:layout/app-body :content wrapped) *)
let nav_path = if String.length path >= 4 && 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
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 server-side.
expand-components? is pre-bound at startup (always true in HTTP mode). *)
let body_result =
let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; 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 t2 = Unix.gettimeofday () in
(* Phase 2: SSR — render to HTML using the SX adapter (render-to-html
from adapter-html.sx) via the CEK evaluator. This handles reactive
primitives (signals, deref, computed) correctly for island SSR.
Falls back to native Sx_render if the SX adapter isn't available. *)
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
if env_has env "render-to-html" then begin
(* SX adapter — handles signals, islands, CSSX *)
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; body_expr];
Env env] in
let result = Sx_ref.eval_expr render_call (Env env) in
match result with
| String s | RawHTML s -> s
| _ -> Sx_runtime.value_to_str result
end else
(* Fallback: native renderer *)
Sx_render.sx_render_to_html env body_expr env
(* Phase 0: Route via SX handler — returns {:is-ajax :nav-path :page-ast} *)
let handler = try env_get env "sx-handle-request" with _ -> Nil in
if handler = Nil then (Printf.eprintf "[http] sx-handle-request not found\n%!"; None)
else
let headers_dict = Hashtbl.create 8 in
List.iter (fun (k, v) ->
Hashtbl.replace headers_dict (String.lowercase_ascii k) (String v)
) headers;
let route_result =
try Sx_ref.cek_call handler
(List [String path; Dict headers_dict; Env env; Nil])
with e ->
Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); ""
Printf.eprintf "[http] route error for %s: %s\n%!" path (Printexc.to_string e);
Nil
in
let t3 = Unix.gettimeofday () in
(* Phase 3: Shell — render directly to buffer for zero-copy output *)
let get_shell_var name = try env_get env ("__shell-" ^ name) with _ -> Nil in
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"; get_shell_var "component-defs";
Keyword "component-hash"; get_shell_var "component-hash";
Keyword "pages-sx"; get_shell_var "pages-sx";
Keyword "sx-css"; get_shell_var "sx-css";
Keyword "sx-css-classes"; get_shell_var "sx-css-classes";
Keyword "asset-url"; get_shell_var "asset-url";
Keyword "sx-js-hash"; get_shell_var "sx-js-hash";
Keyword "body-js-hash"; get_shell_var "body-js-hash";
Keyword "wasm-hash"; get_shell_var "wasm-hash";
Keyword "head-scripts"; get_shell_var "head-scripts";
Keyword "body-scripts"; get_shell_var "body-scripts";
Keyword "inline-css"; get_shell_var "inline-css";
Keyword "inline-head-js"; get_shell_var "inline-head-js";
Keyword "init-sx"; get_shell_var "init-sx";
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
(* Use SX adapter for shell too — it's an SX component *)
let html =
if env_has env "render-to-html" then begin
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; shell_call];
Env env] in
let result = Sx_ref.eval_expr render_call (Env env) in
match result with
| String s | RawHTML s -> s
| _ -> Sx_runtime.value_to_str result
end else
Sx_render.sx_render_to_html env 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
match route_result with
| Nil -> None
| Dict d ->
let is_ajax = match Hashtbl.find_opt d "is-ajax" with Some (Bool true) -> true | _ -> false in
let nav_path = match Hashtbl.find_opt d "nav-path" with Some (String s) -> s | _ -> path in
let page_ast = match Hashtbl.find_opt d "page-ast" with Some v -> v | _ -> Nil in
if page_ast = Nil then None
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 *)
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
end else begin
(* Full page: aser → SSR → shell *)
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
let body_result =
let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; 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 t2 = Unix.gettimeofday () in
let body_html = try
let body_expr = match Sx_parser.parse_all body_str with
| [e] -> e | [] -> Nil | es -> List (Symbol "<>" :: es) in
if env_has env "render-to-html" then
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)
else Sx_render.sx_render_to_html env body_expr env
with e -> Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); "" in
let t3 = Unix.gettimeofday () in
let get_shell name = try env_get env ("__shell-" ^ name) with _ -> Nil in
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"; get_shell "component-defs";
Keyword "component-hash"; get_shell "component-hash";
Keyword "pages-sx"; get_shell "pages-sx";
Keyword "sx-css"; get_shell "sx-css";
Keyword "sx-css-classes"; get_shell "sx-css-classes";
Keyword "asset-url"; get_shell "asset-url";
Keyword "wasm-hash"; get_shell "wasm-hash";
Keyword "inline-css"; get_shell "inline-css";
Keyword "inline-head-js"; get_shell "inline-head-js";
Keyword "init-sx"; get_shell "init-sx";
Keyword "meta-html"; String "";
] in
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
let html =
if env_has env "render-to-html" then
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; shell_call]; 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)
else Sx_render.sx_render_to_html env 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
end
| _ ->
Printf.eprintf "[http] unexpected handler result for %s\n%!" path;
None
(* ====================================================================== *)
(* Static file serving + file hashing *)
@@ -1706,8 +1705,6 @@ let http_inject_shell_statics env static_dir sx_sxc =
let component_defs = raw_defs in
let component_hash = Digest.string component_defs |> Digest.to_hex in
(* Compute file hashes for cache busting *)
let sx_js_hash = file_hash (static_dir ^ "/scripts/sx-browser.js") in
let body_js_hash = file_hash (static_dir ^ "/scripts/body.js") in
let wasm_hash = file_hash (static_dir ^ "/wasm/sx_browser.bc.wasm.js") in
(* Read CSS for inline injection *)
let tw_css = read_css_file (static_dir ^ "/styles/tw.css") in
@@ -1761,11 +1758,7 @@ let http_inject_shell_statics env static_dir sx_sxc =
ignore (env_bind env "__shell-sx-css" (String sx_css));
ignore (env_bind env "__shell-sx-css-classes" (String ""));
ignore (env_bind env "__shell-asset-url" (String "/static"));
ignore (env_bind env "__shell-sx-js-hash" (String sx_js_hash));
ignore (env_bind env "__shell-body-js-hash" (String body_js_hash));
ignore (env_bind env "__shell-wasm-hash" (String wasm_hash));
ignore (env_bind env "__shell-head-scripts" Nil);
ignore (env_bind env "__shell-body-scripts" Nil);
ignore (env_bind env "__shell-inline-css" Nil);
ignore (env_bind env "__shell-inline-head-js" Nil);
(* init-sx: trigger client-side render when sx-root is empty (SSR failed).
@@ -1778,8 +1771,8 @@ let http_inject_shell_statics env static_dir sx_sxc =
SX.renderPage(); \
} \
});"));
Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d js=%s wasm=%s\n%!"
(String.length component_defs) component_hash (String.length sx_css) sx_js_hash wasm_hash
Printf.eprintf "[sx-http] Shell statics: defs=%d hash=%s css=%d wasm=%s\n%!"
(String.length component_defs) component_hash (String.length sx_css) wasm_hash
let http_setup_declarative_stubs env =
(* Stub declarative forms that are metadata-only — no-ops at render time. *)
@@ -1925,6 +1918,7 @@ let http_mode port =
lib_base ^ "/compiler.sx";
web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
web_base ^ "/request-handler.sx";
] in
http_load_files env core_files;
(* Libraries *)
@@ -1961,8 +1955,6 @@ let http_mode port =
load_dir sx_sx;
let t1 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] All files loaded in %.3fs\n%!" (t1 -. t0);
(* Enable lazy JIT — compile lambdas to bytecode on first call *)
register_jit_hook env;
let jt0 = Unix.gettimeofday () in
let count = ref 0 in
let compiler_names = [
@@ -2022,6 +2014,10 @@ let http_mode port =
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
(* Inject shell statics with real file hashes, CSS, and pages registry *)
http_inject_shell_statics env static_dir sx_sxc;
(* Init shared VM globals AFTER all files loaded + shell statics injected.
The env_bind hook keeps it in sync with any future bindings. *)
(* Enable lazy JIT — compile lambdas to bytecode on first call *)
register_jit_hook env;
(* Response cache — path → full HTTP response string.
Populated during pre-warm, serves cached responses in <0.1ms.
Thread-safe: reads are lock-free (Hashtbl.find_opt is atomic for
@@ -2029,7 +2025,7 @@ let http_mode port =
let response_cache : (string, string) Hashtbl.t = Hashtbl.create 128 in
let cache_response path =
match http_render_page env path with
match http_render_page env path [] with
| Some html ->
let resp = http_response html in
Hashtbl.replace response_cache path resp;
@@ -2039,9 +2035,9 @@ let http_mode port =
in
(* Pre-warm + cache all key pages *)
let _warmup_paths = ["/sx/"; "/sx/(geography)"; "/sx/(geography.(reactive.(examples)))";
let _warmup_paths = ["/sx/"; "/sx/(geography)"; "/sx/(language)"; "/sx/(applications)";
"/sx/(geography.(reactive.(examples)))";
"/sx/(applications.(sxtp))"; "/sx/(geography.(cek))";
"/sx/(language)"; "/sx/(applications)";
"/sx/(geography.(reactive))"; "/sx/(geography.(hypermedia))";
] in
let t_warm = Unix.gettimeofday () in
@@ -2086,7 +2082,7 @@ let http_mode port =
let n_workers = max 4 (Domain.recommended_domain_count ()) in
(* Render queue: for cache misses that need full page render *)
let render_queue : (Unix.file_descr * string) list ref = ref [] in
let render_queue : (Unix.file_descr * string * (string * string) list) list ref = ref [] in
let render_mutex = Mutex.create () in
let render_cond = Condition.create () in
let shutdown = ref false in
@@ -2107,13 +2103,14 @@ let http_mode port =
w
in
match work with
| Some (fd, path) ->
| Some (fd, path, headers) ->
let cache_key = if headers <> [] then "ajax:" ^ path else path in
let response =
try
match http_render_page env path with
match http_render_page env path headers with
| Some html ->
let resp = http_response html in
Hashtbl.replace response_cache path resp;
Hashtbl.replace response_cache cache_key resp;
resp
| None -> http_response ~status:404 "<h1>Not Found</h1>"
with e ->
@@ -2127,7 +2124,7 @@ let http_mode port =
(* Fast path: handle a request from the main loop.
Returns true if handled immediately (cached), false if queued. *)
let fast_handle fd data _is_ajax =
let fast_handle fd data is_ajax =
match parse_http_request data with
| None -> write_response fd (http_response ~status:400 "Bad Request"); true
| Some (method_, raw_path) ->
@@ -2141,12 +2138,13 @@ let http_mode port =
let is_sx = path = "/sx/" || path = "/sx"
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in
if is_sx then begin
(* Serve from cache (full page) — client handles sx-select extraction *)
match Hashtbl.find_opt response_cache path with
let cache_key = if is_ajax then "ajax:" ^ path else path in
match Hashtbl.find_opt response_cache cache_key with
| Some cached -> write_response fd cached; true
| None ->
let headers = if is_ajax then parse_http_headers data else [] in
Mutex.lock render_mutex;
render_queue := !render_queue @ [(fd, path)];
render_queue := !render_queue @ [(fd, path, headers)];
Condition.signal render_cond;
Mutex.unlock render_mutex;
false