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

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>
2026-07-03 13:49:43 +00:00
parent 071c2f9a8a
commit dc7aa709bd
14 changed files with 3445 additions and 3213 deletions
--- a/hosts/ocaml/bin/mcp_tree.ml
+++ b/hosts/ocaml/bin/mcp_tree.ml
@@ -375,18 +375,34 @@ let setup_env () =
    | [String s] when String.length s = 1 ->
      let c = s.[0] in Bool ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'))
    | _ -> Bool false);
+  (* Parity with sx_primitives: Integer, not float — make-char requires an
+     Integer codepoint, so the float version broke #\a char literals here. *)
  bind "char-code" (fun args -> match args with
-    | [String s] when String.length s > 0 -> Number (float_of_int (Char.code s.[0]))
-    | _ -> Number 0.0);
+    | [String s] when String.length s > 0 -> Integer (Char.code s.[0])
+    | _ -> Integer 0);
  bind "code-char" (fun args -> match args with
    | [Number n] -> String (String.make 1 (Char.chr (int_of_float n)))
    | _ -> String "");
+  (* Parity with sx_primitives: Integer-aware — the float-only version
+     shadowed the kernel one and broke rationals through the guest parser. *)
  bind "parse-number" (fun args -> match args with
-    | [String s] -> (try Number (float_of_string s) with _ -> Nil)
+    | [String s] ->
+      let has_dec = String.contains s '.' in
+      let has_exp = String.contains s 'e' || String.contains s 'E' in
+      if has_dec || has_exp then
+        (try Number (float_of_string s) with Failure _ -> Nil)
+      else
+        (match int_of_string_opt s with
+         | Some n -> Integer n
+         | None -> (try Number (float_of_string s) with Failure _ -> Nil))
    | _ -> Nil);
  bind "identical?" (fun args -> match args with
    | [a; b] -> Bool (a == b)
    | _ -> Bool false);
+  (* Parity with sx_server: equal? exists in the real runtime env *)
+  bind "equal?" (fun args -> match args with
+    | [a; b] -> Bool (a = b)
+    | _ -> raise (Eval_error "equal?: expected 2 args"));
  (* Character classification for SX parser.sx *)
  bind "ident-start?" (fun args -> match args with
    | [String s] when String.length s = 1 ->
@@ -427,8 +443,10 @@ let setup_env () =
  (* Runtime functions needed by tree-tools *)
  bind "symbol-name" (fun args -> match args with
    | [Symbol s] -> String s | _ -> String "");
+  (* Parity with sx_server: error on non-keyword (was a silent "") *)
  bind "keyword-name" (fun args -> match args with
-    | [Keyword k] -> String k | _ -> String "");
+    | [Keyword k] -> String k
+    | _ -> raise (Eval_error "keyword-name: expected keyword"));
  bind "make-symbol" (fun args -> match args with
    | [String s] -> Symbol s | _ -> Nil);
  (* Environment operations needed by harness *)
@@ -443,12 +461,30 @@ let setup_env () =
    | _ -> Bool false);
  bind "make-env" (fun _args -> Env (make_env ()));
  bind "keys" (fun args -> match args with
-    | [Dict d] -> List (Hashtbl.fold (fun k _ acc -> String k :: acc) d [])
+    | [Dict d] -> List (dict_keys d)
    | _ -> List []);
-  bind "get" (fun args -> match args with
-    | [Dict d; String k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
-    | [Dict d; Keyword k] -> (match Hashtbl.find_opt d k with Some v -> v | None -> Nil)
-    | [List items; Number n] -> (let i = int_of_float n in if i >= 0 && i < List.length items then List.nth items i else Nil)
+  (* Parity with sx_primitives: Integer indices (literals parse as Integer,
+     so the Number-only arm returned nil for every (get lst 1)), Symbol keys,
+     and the 3-arg default form — default only when the key is ABSENT. *)
+  bind "get" (fun args ->
+    let dict_key = function
+      | String k | Keyword k | Symbol k -> Some k
+      | _ -> None in
+    let list_idx = function
+      | Integer i -> Some i
+      | Number n -> Some (int_of_float n)
+      | _ -> None in
+    match args with
+    | [Dict d; key] | [Dict d; key; _] when dict_key key <> None && Hashtbl.mem d (Option.get (dict_key key)) ->
+      Hashtbl.find d (Option.get (dict_key key))
+    | [Dict _; _] -> Nil
+    | [Dict _; _; default] -> default
+    | ([List items; idx] | [ListRef { contents = items }; idx]) when list_idx idx <> None ->
+      (let i = Option.get (list_idx idx) in
+       if i >= 0 && i < List.length items then List.nth items i else Nil)
+    | ([List items; idx; default] | [ListRef { contents = items }; idx; default]) when list_idx idx <> None ->
+      (let i = Option.get (list_idx idx) in
+       if i >= 0 && i < List.length items then List.nth items i else default)
    | _ -> Nil);
  bind "dict-set!" (fun args -> match args with
    | [Dict d; String k; v] -> Hashtbl.replace d k v; v
@@ -478,8 +514,12 @@ let setup_env () =
    | [Number _] -> Bool true | _ -> Bool false);
  bind "callable?" (fun args -> match args with
    | [NativeFn _ | Lambda _ | Component _ | Island _ | VmClosure _] -> Bool true | _ -> Bool false);
+  (* Parity with sx_primitives: empty string and empty dict are empty
+     (test-primitives.sx:89 asserts this; the old arms said false). *)
  bind "empty?" (fun args -> match args with
    | [List []] | [ListRef { contents = [] }] -> Bool true
+    | [String s] -> Bool (String.length s = 0)
+    | [Dict d] -> Bool (Hashtbl.length d = 0)
    | [Nil] -> Bool true | _ -> Bool false);
  bind "contains?" (fun args -> match args with
    | [String s; String sub] ->
@@ -490,6 +530,11 @@ let setup_env () =
      in Bool (String.length sub = 0 || find 0)
    | [List l; v] | [ListRef { contents = l }; v] ->
      Bool (List.exists (fun x -> x = v) l)
+    | [Dict d; key] ->
+      (* Dicts: key check — matches the sx_primitives fix *)
+      (match key with
+       | String k | Keyword k | Symbol k -> Bool (Hashtbl.mem d k)
+       | _ -> Bool false)
    | _ -> Bool false);
  bind "starts-with?" (fun args -> match args with
    | [String s; String prefix] ->
@@ -560,9 +605,28 @@ let setup_env () =
    | _ -> Nil);
  bind "trim" (fun args -> match args with
    | [String s] -> String (String.trim s) | _ -> String "");
+  (* Parity with sx_primitives: literal SUBSTRING separator (the old
+     split_on_char d.[0] was char-class semantics — the historical
+     "split is char-class" gotcha lived HERE, not in the kernel), keeps
+     empties, empty separator → chars, and no crash on "". *)
  bind "split" (fun args -> match args with
-    | [String s; String d] ->
-      List (List.map (fun p -> String p) (String.split_on_char d.[0] s))
+    | [String s; String sep] ->
+      let sl = String.length s and pl = String.length sep in
+      if pl = 0 then
+        List (List.init sl (fun i -> String (String.make 1 s.[i])))
+      else if pl = 1 then
+        List (List.map (fun p -> String p) (String.split_on_char sep.[0] s))
+      else begin
+        let parts = ref [] and start = ref 0 and i = ref 0 in
+        while !i <= sl - pl do
+          if String.sub s !i pl = sep then begin
+            parts := String.sub s !start (!i - !start) :: !parts;
+            start := !i + pl; i := !i + pl
+          end else incr i
+        done;
+        parts := String.sub s !start (sl - !start) :: !parts;
+        List (List.map (fun p -> String p) (List.rev !parts))
+      end
    | _ -> List []);
  (* sx-parse — use the native OCaml parser for bootstrapping *)
  bind "sx-parse" (fun args -> match args with
--- a/hosts/ocaml/bin/run_tests.ml
+++ b/hosts/ocaml/bin/run_tests.ml
@@ -1151,7 +1151,7 @@ let make_test_env () =

  bind "promise?" (fun args ->
    match args with
-    | [v] -> Bool (Sx_ref.is_promise v)
+    | [v] -> Sx_ref.promise_p v
    | _ -> Bool false);

  bind "make-promise" (fun args ->
@@ -1166,7 +1166,7 @@ let make_test_env () =

  bind "force" (fun args ->
    match args with
-    | [p] -> Sx_ref.force_promise p
+    | [p] -> Sx_ref.force p
    | _ -> Nil);

  env
--- a/hosts/ocaml/bin/sx_server.ml
+++ b/hosts/ocaml/bin/sx_server.ml
@@ -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]] ->