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

review quick-wins: JIT gate, crash guards, crit-2 signal-return, regen repair

Browse Source 
Server (sx_server.ml):
- HTTP mode: JIT hook now opt-in via SX_SERVING_JIT, matching epoch mode
  (was unconditional — live serving-JIT miscompiles J1/J2/J3 de-risked)
- command channel: malformed/non-ASCII line returns an error response
  instead of killing the shared process (C1/C1b)
- response cache: soft error pages no longer cached (S4);
  http_render_page returns (html, is_error)

Kernel spec + regen:
- crit-2: signal-return frame stored the saved kont under :f but the reader
  looked up "saved-kont" — handler value became the whole program's result
  and the covering test passed vacuously. Fixed; raise-continuable now also
  resumes at the raise site (rest-k, not unwound-k), mirroring signal-condition
- quasiquote: R7RS longhand unquote-splicing aliased to splice-unquote
  (used to serialize literally — silent zero-splice)
- guard: re-raise sentinel gensym'd per execution (was forgeable by any
  (list '__guard-reraise__ x) value)
- do: IIFE-head form no longer misparses as a Scheme do-loop
- render: area/base/embed/param/track added to HTML_TAGS (were void-only
  and rendered as Undefined symbol)
- REGEN REPAIR: checked-in sx_ref.ml carried hand-written additions that
  every regeneration silently lost (let-values/define-values/delay/
  delay-force registrations, AdtValue define-type) plus 5 regen blockers
  (arrow-name mangling, 3-arg get, &rest defines, HO-position helper refs,
  transpiler prim-table gaps). Moved into bootstrap.py FIXUPS/skips and the
  transpiler prim table — regen is now reproducible, compiles, and tests
  at baseline (CI Dockerfile.test steps 3-4 could not previously have
  produced a compiling kernel)

Primitives:
- contains?: dict key-check arm per its spec doc
- expt: promotes to float on int63 overflow ((expt 2 100) returned 0)
- mcp_tree parity with sx_primitives: get (Integer indices + 3-arg default),
  split (literal substring, was char-class — the historical gotcha lived
  here), empty? on ""/{}, contains?, equal?, keyword-name, char-code
  (Integer), parse-number (Integer-aware)

Python/docs:
- shared/sx/boundary.py: dead validation now logs a one-time WARNING instead
  of silently no-oping (full revival gated: tier-1 declarations deleted and
  SX_BOUNDARY_STRICT=1 is live in production compose)
- CLAUDE.md: canonical reference now points at spec/*.sx; island authoring
  rules corrected (let IS sequential, bodies ARE implicit begin)

Verification: full suite 5762 passed / 274 failed — fail set byte-identical
to the pre-change baseline (273 in-progress hs-* + pre-existing r7rs radix
shadow). All repros verified fixed on both the native binary and the rebuilt
WASM browser kernel. Review findings: /tmp/sx-review/*.md

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 13:49:43 +00:00
parent 071c2f9a8a
commit dc7aa709bd
14 changed files with 3445 additions and 3213 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -2631,8 +2631,12 @@ let http_render_page env path headers =
Printf.eprintf "[http] route error for %s: %s\n%!" path (Printexc.to_string e);
Nil
in
(* Build an error page AST that keeps the layout intact *)
(* Build an error page AST that keeps the layout intact.
Sets is_error_page so callers can avoid caching soft error pages —
a transient routing failure must not be served from cache until restart. *)
let is_error_page = ref false in
let error_page_ast msg =
is_error_page := true;
List [Symbol "div"; Keyword "class"; String "p-8 max-w-2xl mx-auto";
List [Symbol "h2"; Keyword "class"; String "text-xl font-semibold text-rose-600 mb-4";
String "Page Error"];
@@ -2672,7 +2676,7 @@ let http_render_page env path headers =
| String s | SxExpr s -> s | _ -> serialize_value body_result in
let t1 = Unix.gettimeofday () in
Printf.eprintf "[sx-http] %s (SX) aser=%.3fs body=%d\n%!" path (t1 -. t0) (String.length body_str);
Some body_str
Some (body_str, !is_error_page)
end else begin
(* Full page: aser → SSR → shell *)
let outer_layout = get_app_str "outer-layout" "~shared:layout/app-body" in
@@ -2727,7 +2731,7 @@ let http_render_page env path headers =
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
Some (html, !is_error_page)
end
end
@@ -4159,8 +4163,18 @@ let http_mode port =
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;
(* Lazy JIT is OPT-IN via SX_SERVING_JIT=1, matching the epoch serving mode.
The serving JIT has confirmed miscompiles (`->` in argument position
evaluates steps once per remaining step and leaves stack residue; any
VM exception re-runs the whole call on the CEK, double-applying side
effects; user-macro call args are evaluated eagerly before fallback).
Until those are fixed, HTTP rendering runs on the CEK by default —
the response cache carries the hot paths. *)
(match Sys.getenv_opt "SX_SERVING_JIT" with
| Some ("1" | "true" | "yes" | "on") ->
register_jit_hook env
| _ ->
Printf.eprintf "[sx-http] serving JIT disabled (opt in with SX_SERVING_JIT=1)\n%!");
(* Install global IO resolver so perform works inside aser/eval_expr.
This lets components call measure-text during server-side rendering. *)
Sx_types._cek_io_resolver := Some (fun request _state ->
@@ -4207,7 +4221,9 @@ let http_mode port =
let cache_response path =
match http_render_page env path [] with
| Some html ->
| Some (_, true) ->
Printf.eprintf "[cache] %s → error page, not cached\n%!" path
| Some (html, false) ->
let resp = http_response html in
Hashtbl.replace response_cache path resp;
Printf.eprintf "[cache] %s → %d bytes\n%!" path (String.length html)
@@ -4297,7 +4313,7 @@ let http_mode port =
let response =
try
match http_render_page env path headers with
| Some body ->
| Some (body, is_err) ->
(* htmx requests get HTML; SX requests get SX wire format *)
let final_body = if is_htmx then
(try
@@ -4309,7 +4325,7 @@ let http_mode port =
let ct = if is_ajax && not is_htmx then "text/sx; charset=utf-8"
else "text/html; charset=utf-8" in
let resp = http_response ~content_type:ct final_body in
Hashtbl.replace response_cache cache_key resp;
if not is_err then Hashtbl.replace response_cache cache_key resp;
resp
| None -> http_response ~status:404 "<h1>Not Found</h1>"
with e ->
@@ -4663,7 +4679,7 @@ let http_mode port =
String.lowercase_ascii k = "hx-request") headers in
let response =
try match http_render_page env path headers with
| Some body ->
| Some (body, is_err) ->
let final_body = if is_htmx then
(try
let exprs = Sx_parser.parse_all body in
@@ -4674,7 +4690,7 @@ let http_mode port =
let ct = if is_htmx then "text/html; charset=utf-8"
else "text/sx; charset=utf-8" in
let resp = http_response ~content_type:ct final_body in
if not is_htmx then Hashtbl.replace response_cache cache_key resp;
if not is_htmx && not is_err then Hashtbl.replace response_cache cache_key resp;
resp
| None -> http_response ~status:404
"(div :class \"p-8\" (h2 :class \"text-rose-600 font-semibold\" \"Page not found\") (p :class \"text-stone-500\" \"No route matched this path\"))"
@@ -4690,7 +4706,7 @@ let http_mode port =
Don't cache: response varies by cookie value. *)
let response =
try match http_render_page env path [] with
| Some body -> http_response body
| Some (body, _) -> http_response body
| None -> http_response ~status:404 "<h1>Not Found</h1>"
with e ->
Printf.eprintf "[render] Cookie render error for %s: %s\n%!" path (Printexc.to_string e);
@@ -4947,7 +4963,11 @@ let site_mode () =
let line = String.trim line in
if line = "" then ()
else begin
let exprs = Sx_parser.parse_all line in
(* A malformed line must never kill the shared command channel:
report it as an error response and keep serving. *)
match (try Ok (Sx_parser.parse_all line) with e -> Error e) with
| Error e -> send_error ("Malformed command line: " ^ Printexc.to_string e)
| Ok exprs ->
match exprs with
| [List [Symbol "epoch"; Number n]] ->
current_epoch := int_of_float n
@@ -4956,7 +4976,7 @@ let site_mode () =
(* render-page: full SSR pipeline — URL → complete HTML *)
| [List [Symbol "render-page"; String path]] ->
(try match http_render_page env path [] with
| Some html -> send_ok_blob html
| Some (html, _) -> send_ok_blob html
| None -> send_error ("render-page: no route for " ^ path)
with e -> send_error ("render-page: " ^ Printexc.to_string e))
(* nav-urls: flat list of (href label) from nav tree *)
@@ -5045,7 +5065,11 @@ let () =
Printf.eprintf "[sx-server] discarding stale io-response (%d chars)\n%!"
(String.length line)
else begin
let exprs = Sx_parser.parse_all line in
(* A malformed line must never kill the shared command channel:
report it as an error response and keep serving. *)
match (try Ok (Sx_parser.parse_all line) with e -> Error e) with
| Error e -> send_error ("Malformed command line: " ^ Printexc.to_string e)
| Ok exprs ->
match exprs with
(* Epoch marker: (epoch N) — set current epoch, read next command *)
| [List [Symbol "epoch"; Number n]] ->