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

19
CLAUDE.md
View File

@@ -173,15 +173,16 @@ artdag/
## SX Language — Canonical Reference
The SX language is defined by a self-hosting specification in `shared/sx/ref/`. **Read these files for authoritative SX semantics** — they supersede any implementation detail in `sx.js` or Python evaluators.
The SX language is defined by a self-hosting specification in `spec/`. **Read these files for authoritative SX semantics.** (The former `shared/sx/ref/*.sx` copies were deleted — only `BOUNDARY.md` remains there.) The spec is transpiled into the OCaml kernel (`hosts/ocaml/lib/sx_ref.ml`, generated by `hosts/ocaml/bootstrap.py` — never edit the generated file; edit the spec and regenerate).
### Specification files
- **`shared/sx/ref/eval.sx`** — Core evaluator: types, trampoline (TCO), `eval-expr` dispatch, special forms (`if`, `when`, `cond`, `case`, `let`, `and`, `or`, `lambda`, `define`, `defcomp`, `defmacro`, `quasiquote`), higher-order forms (`map`, `filter`, `reduce`, `some`, `every?`, `for-each`), macro expansion, function/lambda/component calling.
- **`shared/sx/ref/parser.sx`** — Tokenizer and parser: grammar, string escapes, dict literals `{:key val}`, quote sugar (`` ` ``, `,`, `,@`), serializer.
- **`shared/sx/ref/primitives.sx`** — All ~80 built-in pure functions: arithmetic, comparison, predicates, string ops, collection ops, dict ops, format helpers, CSSX style primitives.
- **`shared/sx/ref/render.sx`** — Three rendering modes: `render-to-html` (server HTML), `render-to-sx`/`aser` (SX wire format for client), `render-to-dom` (browser). HTML tag registry, void elements, boolean attrs.
- **`shared/sx/ref/bootstrap_js.py`** — Transpiler: reads the `.sx` spec files and emits `sx-ref.js`.
- **`spec/evaluator.sx`** — The CEK-machine evaluator: frames, TCO trampoline, `step`/dispatch, special forms (`if`, `when`, `cond`, `case`, `let`, `and`, `or`, `lambda`, `define`, `defcomp`, `defmacro`, `quasiquote`, `guard`, `handler-bind`), higher-order forms (`map`, `filter`, `reduce`, `some`, `every?`, `for-each`), continuations (`call/cc`, `reset`/`shift`), macro expansion, strict-typing machinery, function/lambda/component calling.
- **`spec/parser.sx`** — Tokenizer and parser: grammar, string escapes, dict literals `{:key val}`, quote sugar (`` ` ``, `,`, `,@`), serializer.
- **`spec/primitives.sx`** — Declarative specs for the built-in pure functions: arithmetic, comparison, predicates, string ops, collection ops, dict ops, format helpers, CSSX style primitives.
- **`spec/render.sx`** — Rendering registries + escaping (HTML tag registry, void elements, boolean attrs); the mode dispatch (`render-to-html`, `aser`, `render-to-dom`) lives in `web/adapter-*.sx`.
- **`spec/special-forms.sx`, `spec/eval-rules.sx`** — Form specs and machine-readable evaluation rules.
- **`spec/signals.sx`, `spec/coroutines.sx`, `spec/canonical.sx`, `spec/stdlib.sx`** — Reactive signals, coroutines, canonical serialization, stdlib.
- **`spec/harness.sx`** — Test harness: mock IO platform for testing components. Sessions, IO interception, log queries, assertions (`assert-io-called`, `assert-io-count`, `assert-io-args`, `assert-no-io`, `assert-state`). Extensible — new platforms add entries to the platform dict. Loaded automatically by test runners.
- **`spec/tests/test-harness.sx`** — Tests for the harness itself (15 tests).
@@ -310,7 +311,7 @@ cd artdag/l1 && mypy app/types.py app/routers/recipes.py tests/
### SX Rendering Pipeline
The SX system renders component trees defined in s-expressions. Canonical semantics are in `shared/sx/ref/` (see "SX Language" section above). The same AST can be evaluated in different modes depending on where the server/client rendering boundary is drawn:
The SX system renders component trees defined in s-expressions. Canonical semantics are in `spec/` (see "SX Language" section above). The same AST can be evaluated in different modes depending on where the server/client rendering boundary is drawn:
- `render_to_html(name, **kw)` — server-side, produces HTML. Maps to `render-to-html` in the spec.
- `render_to_sx(name, **kw)` — server-side, produces SX wire format. Maps to `aser` in the spec. Component calls stay **unexpanded**.
@@ -450,7 +451,7 @@ printf '(epoch 1)\n(prim-check "my-compiled-fn")\n' | sx_server.exe
Key patterns discovered from the reactive runtime demos (see `sx/sx/reactive-runtime.sx`):
1. **Multi-expression bodies need `(do ...)`** — `fn`, `let`, and `when` bodies evaluate only the last expression. Wrap multiples in `(do expr1 expr2 expr3)`.
2. **`let` is parallel, not sequential** — bindings in the same `let` can't reference each other. Use nested `let` blocks when functions need to reference signals defined earlier.
1. **Multi-expression bodies sequence (implicit begin)** — `fn`, `let`, and `when` bodies evaluate every expression and return the last (verified on both the CEK and the VM; the old "only the last expression runs" rule described a deleted evaluator). `(do ...)` still works and is fine for clarity.
2. **`let` is SEQUENTIAL (`let*` semantics)** — later bindings see earlier ones (`(let ((a 1) (b a)) b)` → 1; tested intent, both engines). `cond`, however, has a mode-detection footgun with multi-expression clause bodies — use flat pairs with explicit `(do ...)` results.
3. **Reactive text needs `(deref (computed ...))`** — bare `(len (deref items))` is NOT reactive. Wrap in `(deref (computed (fn () (len (deref items)))))`.
4. **Effects go in inner `let`** — signals in outer `let`, functions and effects in inner `let`. The OCaml SSR evaluator can't resolve outer `let` bindings from same-`let` lambdas.

86
hosts/ocaml/bin/mcp_tree.ml
View File

@@ -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

4
hosts/ocaml/bin/run_tests.ml
View File

@@ -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

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]] ->

77
hosts/ocaml/bootstrap.py
View File

@@ -156,8 +156,7 @@ let sf_define_type args env_val =
(match pargs with
| [v] ->
(match v with
| Dict d -> Bool (Hashtbl.mem d "_adt" &&
(match Hashtbl.find_opt d "_type" with Some (String t) -> t = type_name | _ -> false))
| AdtValue a -> Bool (a.av_type = type_name)
| _ -> Bool false)
| _ -> Bool false)));
List.iter (fun spec ->
@@ -171,21 +170,18 @@ let sf_define_type args env_val =
if List.length ctor_args <> arity then
raise (Eval_error (Printf.sprintf "%s: expected %d args, got %d"
cn arity (List.length ctor_args)))
else begin
let d = Hashtbl.create 4 in
Hashtbl.replace d "_adt" (Bool true);
Hashtbl.replace d "_type" (String type_name);
Hashtbl.replace d "_ctor" (String cn);
Hashtbl.replace d "_fields" (List ctor_args);
Dict d
end));
else
AdtValue {
av_type = type_name;
av_ctor = cn;
av_fields = Array.of_list ctor_args;
}));
env_bind_v (cn ^ "?")
(NativeFn (cn ^ "?", fun pargs ->
(match pargs with
| [v] ->
(match v with
| Dict d -> Bool (Hashtbl.mem d "_adt" &&
(match Hashtbl.find_opt d "_ctor" with Some (String c) -> c = cn | _ -> false))
| AdtValue a -> Bool (a.av_ctor = cn)
| _ -> Bool false)
| _ -> Bool false)));
List.iteri (fun idx fname ->
@@ -194,28 +190,53 @@ let sf_define_type args env_val =
(match pargs with
| [v] ->
(match v with
| Dict d ->
(match Hashtbl.find_opt d "_fields" with
| Some (List fs) ->
if idx < List.length fs then List.nth fs idx
| AdtValue a ->
if idx < Array.length a.av_fields then a.av_fields.(idx)
else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not a dict")))
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": expected 1 arg")))))
) field_names
| _ -> ())
) ctor_specs;
Nil
(* Register define-type via custom_special_forms so the CEK dispatch finds it.
The top-level (register-special-form! ...) in spec/evaluator.sx is not a
define and therefore is not transpiled; we wire it up here instead. *)
(* Register special forms via custom_special_forms so the CEK dispatch finds
them. The top-level (register-special-form! ...) calls in spec/evaluator.sx
are not defines and therefore are not transpiled; we wire them up here.
let-values/define-values/delay/delay-force point at the TRANSPILED spec
functions (sf_let_values etc.) — these registrations were previously
hand-appended to the generated sx_ref.ml and were silently lost on every
regeneration (2026-07 review). *)
let () = ignore (register_special_form (String "define-type")
(NativeFn ("define-type", fun call_args ->
match call_args with
| [args; env] -> sf_define_type args env
| _ -> Nil)))
let () = ignore (register_special_form (String "let-values")
(NativeFn ("let-values", fun call_args ->
match call_args with
| [args; env] -> sf_let_values args env
| _ -> Nil)))
let () = ignore (register_special_form (String "define-values")
(NativeFn ("define-values", fun call_args ->
match call_args with
| [args; env] -> sf_define_values args env
| _ -> Nil)))
let () = ignore (register_special_form (String "delay")
(NativeFn ("delay", fun call_args ->
match call_args with
| [args; env] -> sf_delay args env
| _ -> Nil)))
let () = ignore (register_special_form (String "delay-force")
(NativeFn ("delay-force", fun call_args ->
match call_args with
| [args; env] -> sf_delay_force args env
| _ -> Nil)))
"""
@@ -263,7 +284,21 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
"pad-left", "pad-right", "char-at", "substring",
# sf-define-type uses &rest + empty-dict literals that the transpiler
# can't emit as valid OCaml; hand-written implementation in FIXUPS.
"sf-define-type"}
"sf-define-type",
# Arrow-named portability shims for non-OCaml hosts. All three
# are registered natively in sx_primitives.ml, and the
# transpiler has no mangling rule for '>' in identifiers
# (emits invalid OCaml like `string_>symbol`).
"string->symbol", "symbol->string", "integer->char",
# values/in-range use &rest, which the transpiler can't emit
# (see sf-define-type above). in-range is registered natively;
# values has never been in the compiled kernel — bound only in
# run_tests.ml (2026-07 review F-7); making it a real kernel
# primitive is a tracked follow-up.
"values", "in-range", "build-range",
# zero-arg guest shim; the native gensym (with optional
# prefix) is registered in sx_primitives.ml
"gensym"}
defines = [(n, e) for n, e in defines if n not in skip]
# Deduplicate — keep last definition for each name (CEK overrides tree-walk)

22
hosts/ocaml/lib/sx_primitives.ml
View File

@@ -430,8 +430,20 @@ let () =
register "expt" (fun args ->
match args with
| [Integer a; Integer b] when b >= 0 ->
let rec ipow base e acc = if e = 0 then acc else ipow base (e - 1) (acc * base) in
Integer (ipow a b 1)
(* Overflow-checked integer power: promote to float instead of
silently wrapping int63 ((expt 2 100) used to return 0). *)
let mul_ovf x y =
if x = 0 || y = 0 then Some 0
else let p = x * y in
if p / y <> x then None else Some p in
let rec ipow base e acc =
if e = 0 then Some acc
else match mul_ovf acc base with
| None -> None
| Some acc' -> ipow base (e - 1) acc' in
(match ipow a b 1 with
| Some n -> Integer n
| None -> Number (Float.pow (float_of_int a) (float_of_int b)))
| [a; b] -> Number (Float.pow (as_number a) (as_number b))
| _ -> raise (Eval_error "expt: 2 args"));
register "quotient" (fun args ->
@@ -1227,6 +1239,12 @@ let () =
else if String.sub s i (String.length sub) = sub then true
else find (i + 1)
in Bool (find 0)
| [Dict d; key] ->
(* Dicts: key check (per the spec doc). Keywords evaluate to their
string name, so (contains? {:a 1} :a) arrives as String "a". *)
(match key with
| String k | Keyword k | Symbol k -> Bool (Hashtbl.mem d k)
| _ -> Bool false)
| _ -> raise (Eval_error "contains?: 2 args"));
register "range" (fun args ->
match args with

297
hosts/ocaml/lib/sx_ref.ml
View File

File diff suppressed because one or more lines are too long

6
hosts/ocaml/lib/sx_types.ml
View File

@@ -904,6 +904,12 @@ let dict_set (d : dict) key v = Hashtbl.replace d key v
let dict_delete (d : dict) key = Hashtbl.remove d key
(* keys/vals order: OCaml Hashtbl fold order is unspecified (in practice
reverse insertion for fresh tables). NOTE (2026-07 review): this is a
determinism footgun for serialization/content-addressing, but render
attr emission depends on the current order (tests pin source-order
attributes), so changing it is gated on the insertion-order dict ruling
(RULINGS R29) — do not "fix" locally. *)
let dict_keys (d : dict) =
Hashtbl.fold (fun k _ acc -> String k :: acc) d []

8
hosts/ocaml/transpiler.sx
View File

@@ -956,7 +956,13 @@
(= op "starts-with?")
(= op "ends-with?")
(= op "string-contains?")
(= op "string-length"))
(= op "string-length")
(= op "vector?")
(= op "vector->list")
(= op "list->vector")
(= op "vector-length")
(= op "vector-ref")
(= op "gensym"))
(str
"(prim_call "
(ml-quote-string op)

5984
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["unix-100664f4",[2]],["sx-809891af",[2,3,4]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,6]],["dune__exe__Sx_browser-4878f9e1",[2,5,7]],["std_exit-10fb8830",[2]],["start-8c705527",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["re-9a0de245",[2]],["unix-100664f4",[2]],["sx-c1aa02f5",[2,3,4]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,6]],["dune__exe__Sx_browser-b2ad0885",[2,5,7]],["std_exit-10fb8830",[2]],["start-8c705527",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new

23
shared/sx/boundary.py
View File

@@ -26,8 +26,21 @@ _DECLARED_IO: frozenset[str] | None = None
_DECLARED_HELPERS: dict[str, frozenset[str]] | None = None
_LOAD_FAILURE_WARNED = False
def _load_declarations() -> None:
global _DECLARED_PURE, _DECLARED_IO, _DECLARED_HELPERS
# KNOWN-BROKEN (2026-07 review, finding C24): `.ref.boundary_parser` was
# moved to hosts/python/boundary_parser.py AND its tier-1 declaration
# source (shared/sx/ref/boundary.sx) was deleted, so this ImportError
# fires on every call and boundary validation has been a silent no-op —
# including under SX_BOUNDARY_STRICT=1, which production compose sets.
# Do NOT "fix" the import in isolation: reviving validation while strict
# mode is live in production requires first recreating the core
# declarations and proving zero violations across all services
# (remediation plan, Phase 2 "Python boundary"). Until then we make the
# dead state visible instead of silent.
global _DECLARED_PURE, _DECLARED_IO, _DECLARED_HELPERS, _LOAD_FAILURE_WARNED
if _DECLARED_PURE is not None:
return
try:
@@ -42,6 +55,14 @@ def _load_declarations() -> None:
# Don't cache failure — parser may not be ready yet (circular import
# during startup). Will retry on next call. Validation functions
# skip checks when declarations aren't loaded.
if not _LOAD_FAILURE_WARNED:
_LOAD_FAILURE_WARNED = True
logger.warning(
"SX boundary validation is INACTIVE (declarations failed to "
"load: %s). All validate_* calls are no-ops, even under "
"SX_BOUNDARY_STRICT=1.", e,
)
else:
logger.debug("Boundary declarations not ready yet: %s", e)

60
spec/evaluator.sx
View File

@@ -1312,7 +1312,12 @@
(= (type-of item) "list")
(= (len item) 2)
(= (type-of (first item)) "symbol")
(= (symbol-name (first item)) "splice-unquote"))
;; ,@ parses to splice-unquote; accept the R7RS longhand
;; unquote-splicing too (it used to serialize literally —
;; a silent zero-splice)
(or
(= (symbol-name (first item)) "splice-unquote")
(= (symbol-name (first item)) "unquote-splicing")))
(let
((spliced (trampoline (eval-expr (nth item 1) env))))
(if
@@ -1395,7 +1400,9 @@
(let
((result (apply producer (list))))
(if
(and (dict? result) (get result :_values false))
;; 2-arg get: absent key → nil (falsy) — the explicit false default
;; was redundant AND the OCaml transpiler only emits 2-arg get
(and (dict? result) (get result :_values))
(apply consumer (get result :_list))
(apply consumer (list result))))))
@@ -1415,7 +1422,7 @@
(let
((result (trampoline (eval-expr val-expr local))))
(let
((vs (if (and (dict? result) (get result :_values false)) (get result :_list) (list result))))
((vs (if (and (dict? result) (get result :_values)) (get result :_list) (list result))))
(for-each-indexed
(fn
(idx name)
@@ -1442,7 +1449,7 @@
(let
((result (trampoline (eval-expr val-expr env))))
(let
((vs (if (and (dict? result) (get result :_values false)) (get result :_list) (list result))))
((vs (if (and (dict? result) (get result :_values)) (get result :_list) (list result))))
(for-each-indexed
(fn (idx name) (env-bind! env (symbol-name name) (nth vs idx)))
names)
@@ -1699,7 +1706,9 @@
(body (rest args))
(var (first var-clauses))
(clauses (rest var-clauses))
(sentinel (make-symbol "__guard-reraise__")))
;; gensym: fresh tag per guard execution — a user value shaped
;; (list '__guard-reraise__ x) must not be mistaken for a re-raise
(sentinel (gensym "__guard-reraise__")))
(step-eval-list
(list
(quote let)
@@ -1841,12 +1850,18 @@
("io" (step-sf-io args env kont))
("begin" (step-sf-begin args env kont))
("do"
;; do-loop only when it really looks like Scheme do:
;; every element of the first form is a (var init [step])
;; list AND a test-clause list follows. A begin-style
;; (do ((fn (x) x) 5) ...) — IIFE head — used to misparse
;; as a binding list.
(if
(and
(not (empty? args))
(>= (len args) 2)
(list? (first args))
(not (empty? (first args)))
(list? (first (first args))))
(every? (fn (b) (list? b)) (first args))
(list? (nth args 1)))
(let
((bindings (first args))
(test-clause (nth args 1))
@@ -2056,7 +2071,9 @@
(args env)
(let ((thunk (make-lambda (list) (first args) env))) {:_iterative true :forced false :value nil :thunk thunk :_promise true})))
(define promise? (fn (v) (and (dict? v) (get v :_promise false))))
;; 2-arg get throughout: absent key → nil (falsy) — explicit false/nil
;; defaults were redundant AND the OCaml transpiler only emits 2-arg get
(define promise? (fn (v) (and (dict? v) (get v :_promise))))
;; ═══════════════════════════════════════════════════════════════
;; Part 11: Entry Points
@@ -2075,12 +2092,12 @@
(not (promise? p))
p
(if
(get p :forced false)
(get p :value nil)
(get p :forced)
(get p :value)
(let
((result (apply (get p :thunk nil) (list))))
((result (apply (get p :thunk) (list))))
(let
((final (if (and (get p :_iterative false) (promise? result)) (force result) result)))
((final (if (and (get p :_iterative) (promise? result)) (force result) result)))
(dict-set! p :forced true)
(dict-set! p :value final)
final))))))
@@ -2971,12 +2988,15 @@
((registered
(get (env-get env "*adt-registry*") type-name)))
(when
(and registered (not (some match-clause-is-else? clauses)))
;; eta-expanded: a bare helper in HO position transpiles to
;; cek_call on an OCaml function (type error); a lambda body
;; calling it directly emits a plain application
(and registered (not (some (fn (c) (match-clause-is-else? c)) clauses)))
(let
((clause-ctors
(filter
(fn (n) (not (nil? n)))
(map match-clause-ctor-name clauses))))
(map (fn (c) (match-clause-ctor-name c)) clauses))))
(match-warn-non-exhaustive
env type-name registered clause-ctors)))))))))
@@ -4507,8 +4527,12 @@
rest-k)))))
("restart" (make-cek-value value env rest-k))
("signal-return"
;; the frame constructor stores the caller's kont under :f
;; (natively cf_f) — reading "saved-kont" returned nil and
;; silently discarded the whole continuation outside the
;; signal site (handler value became the program's result)
(let
((saved-kont (get frame "saved-kont")))
((saved-kont (get frame "f")))
(make-cek-value value (get frame "env") saved-kont)))
("comp-trace" (make-cek-value value env rest-k))
("cond-arrow"
@@ -4565,8 +4589,12 @@
(list condition)
(if
continuable?
;; R7RS: the handler's value returns to the RAISE SITE,
;; so save rest-k (the kont at raise time) — unwound-k
;; has already dropped the frames between the raise
;; site and the handler (mirrors step-sf-signal)
(kont-push
(make-signal-return-frame fenv unwound-k)
(make-signal-return-frame fenv rest-k)
unwound-k)
(kont-push
(make-raise-guard-frame fenv unwound-k)

10
spec/render.sx
View File

@@ -160,7 +160,15 @@
"template"
"slot"
"dialog"
"menu"))
"menu"
;; void elements must ALSO be here — render routes a head symbol to
;; the element renderer only when it's in HTML_TAGS; these five were
;; only in VOID_ELEMENTS and fell through to "Undefined symbol"
"area"
"base"
"embed"
"param"
"track"))
;; Self-closing tags (br, img, hr, etc.)
(define