SxExpr aser wire format fix + Playwright test infrastructure + blob protocol

Aser serialization: aser-call/fragment now return SxExpr instead of String.
serialize/inspect passes SxExpr through unquoted, preventing the double-
escaping (\" → \\\" ) that broke client-side parsing when aser wire format
was output via raw! into <script> tags. Added make-sx-expr + sx-expr-source
primitives to OCaml and JS hosts.

Binary blob protocol: eval, aser, aser-slot, and sx-page-full now send SX
source as length-prefixed blobs instead of escaped strings. Eliminates pipe
desync from concurrent requests and removes all string-escape round-trips
between Python and OCaml.

Bridge safety: re-entrancy guard (_in_io_handler) raises immediately if an
IO handler tries to call the bridge, preventing silent deadlocks.

Fetch error logging: orchestration.sx error callback now logs method + URL
via log-warn. Platform catches (fetchAndRestore, fetchPreload, bindBoostForm)
also log errors instead of silently swallowing them.

Transpiler fixes: makeEnv, scopePeek, scopeEmit, makeSxExpr added as
platform function definitions + transpiler mappings — were referenced in
transpiled code but never defined as JS functions.

Playwright test infrastructure:
- nav() captures JS errors and fails fast with the actual error message
- Checks for [object Object] rendering artifacts
- New tests: delete-row interaction, full page refresh, back button,
  direct load with fresh context, code block content verification
- Default base URL changed to localhost:8013 (standalone dev server)
- docker-compose.dev-sx.yml: port 8013 exposed for local testing
- test-sx-build.sh: build + unit tests + Playwright smoke tests

Geography content: index page component written (sx/sx/geography/index.sx)
describing OCaml evaluator, wire formats, rendering pipeline, and topic
links. Wiring blocked by aser-expand-component children passing issue.

Tests: 1080/1080 JS, 952/952 OCaml, 66/66 Playwright

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-22 22:17:43 +00:00
parent 6d73edf297
commit df461beec2
17 changed files with 684 additions and 82 deletions

View File

@@ -1130,8 +1130,10 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
PRIMITIVES["emit!"] = sxEmit;
PRIMITIVES["emitted"] = sxEmitted;
// Aliases for aser adapter (avoids CEK special form conflict on server)
PRIMITIVES["scope-emit!"] = sxEmit;
PRIMITIVES["scope-peek"] = sxEmitted;
var scopeEmit = sxEmit;
var scopePeek = sxEmitted;
PRIMITIVES["scope-emit!"] = scopeEmit;
PRIMITIVES["scope-peek"] = scopePeek;
''',
}
# Modules to include by default (all)
@@ -1170,6 +1172,7 @@ PLATFORM_JS_PRE = '''
if (x._spread) return "spread";
if (x._macro) return "macro";
if (x._raw) return "raw-html";
if (x._sx_expr) return "sx-expr";
if (typeof Node !== "undefined" && x instanceof Node) return "dom-node";
if (Array.isArray(x)) return "list";
if (typeof x === "object") return "dict";
@@ -1441,6 +1444,7 @@ PLATFORM_JS_POST = '''
// escape-html and escape-attr are now library functions defined in render.sx
function rawHtmlContent(r) { return r.html; }
function makeRawHtml(s) { return { _raw: true, html: s }; }
function makeSxExpr(s) { return { _sx_expr: true, source: s }; }
function sxExprSource(x) { return x && x.source ? x.source : String(x); }
// Placeholders — overridden by transpiled spec from parser.sx / adapter-sx.sx
@@ -1669,7 +1673,8 @@ CEK_FIXUPS_JS = '''
PRIMITIVES["island?"] = isIsland;
PRIMITIVES["make-symbol"] = function(n) { return new Symbol(n); };
PRIMITIVES["is-html-tag?"] = function(n) { return HTML_TAGS.indexOf(n) >= 0; };
PRIMITIVES["make-env"] = function() { return merge(componentEnv, PRIMITIVES); };
function makeEnv() { return merge(componentEnv, PRIMITIVES); }
PRIMITIVES["make-env"] = makeEnv;
// localStorage — defined here (before boot) so islands can use at hydration
PRIMITIVES["local-storage-get"] = function(key) {
@@ -1792,7 +1797,7 @@ PLATFORM_PARSER_JS = r"""
function escapeString(s) {
return s.replace(/\\/g, "\\\\").replace(/"/g, '\\"').replace(/\n/g, "\\n").replace(/\t/g, "\\t");
}
function sxExprSource(e) { return typeof e === "string" ? e : String(e); }
function sxExprSource(e) { return typeof e === "string" ? e : (e && e.source ? e.source : String(e)); }
var charFromCode = PRIMITIVES["char-from-code"];
"""
@@ -2298,7 +2303,10 @@ PLATFORM_ORCHESTRATION_JS = """
}
}
});
}).catch(function() { location.reload(); });
}).catch(function(err) {
logWarn("sx:popstate fetch error " + url + "" + (err && err.message ? err.message : err));
location.reload();
});
}
function fetchStreaming(target, url, headers) {
@@ -2436,7 +2444,9 @@ PLATFORM_ORCHESTRATION_JS = """
return resp.text().then(function(text) {
preloadCacheSet(cache, url, text, ct);
});
}).catch(function() { /* ignore */ });
}).catch(function(err) {
logInfo("sx:preload error " + url + "" + (err && err.message ? err.message : err));
});
}
// --- Request body building ---
@@ -2725,6 +2735,8 @@ PLATFORM_ORCHESTRATION_JS = """
var liveAction = form.getAttribute("action") || _action || location.href;
executeRequest(form, { method: liveMethod, url: liveAction }).then(function() {
try { history.pushState({ sxUrl: liveAction, scrollY: window.scrollY }, "", liveAction); } catch (err) {}
}).catch(function(err) {
logWarn("sx:boost form error " + liveMethod + " " + liveAction + "" + (err && err.message ? err.message : err));
});
});
}

View File

@@ -218,6 +218,19 @@ env["component-has-children"] = function(c) {
return c && c.has_children ? c.has_children : false;
};
// Aser test helper: parse SX source, evaluate via aser, return wire format string
env["render-sx"] = function(source) {
const exprs = Sx.parse(source);
const parts = [];
for (const expr of exprs) {
const result = Sx.renderToSx(expr, env);
if (result !== null && result !== undefined && result !== Sx.NIL) {
parts.push(typeof result === "string" ? result : Sx.serialize(result));
}
}
return parts.join("");
};
// Platform test functions
env["try-call"] = function(thunk) {
try {

View File

@@ -54,6 +54,8 @@
"make-action-def" "makeActionDef"
"make-page-def" "makePageDef"
"make-symbol" "makeSymbol"
"make-env" "makeEnv"
"make-sx-expr" "makeSxExpr"
"make-keyword" "makeKeyword"
"lambda-params" "lambdaParams"
"lambda-body" "lambdaBody"
@@ -163,6 +165,7 @@
"aser-special" "aserSpecial"
"eval-case-aser" "evalCaseAser"
"sx-serialize" "sxSerialize"
"sx-serialize-dict" "sxSerializeDict"
"sx-expr-source" "sxExprSource"
"sf-if" "sfIf"
@@ -620,6 +623,8 @@
"cond-scheme?" "condScheme_p"
"scope-push!" "scopePush"
"scope-pop!" "scopePop"
"scope-emit!" "scopeEmit"
"scope-peek" "scopePeek"
"provide-push!" "providePush"
"provide-pop!" "providePop"
"context" "sxContext"

View File

@@ -97,6 +97,29 @@ let read_line_blocking () =
try Some (input_line stdin)
with End_of_file -> None
(** Read exactly N bytes from stdin (blocking). *)
let read_exact_bytes n =
let buf = Bytes.create n in
really_input stdin buf 0 n;
Bytes.to_string buf
(** Read a length-prefixed blob from stdin.
Expects the next line to be "(blob N)" where N is byte count,
followed by exactly N bytes of raw data, then a newline. *)
let read_blob () =
match read_line_blocking () with
| None -> raise (Eval_error "read_blob: stdin closed")
| Some line ->
let line = String.trim line in
match Sx_parser.parse_all line with
| [List [Symbol "blob"; Number n]] ->
let len = int_of_float n in
let data = read_exact_bytes len in
(* consume trailing newline *)
(try ignore (input_line stdin) with End_of_file -> ());
data
| _ -> raise (Eval_error ("read_blob: expected (blob N), got: " ^ line))
(** Batch IO mode — collect requests during aser-slot, resolve after. *)
let io_batch_mode = ref false
let io_queue : (int * string * value list) list ref = ref []
@@ -120,8 +143,8 @@ let io_request name args =
incr io_counter;
let id = !io_counter in
io_queue := (id, name, args) :: !io_queue;
(* Placeholder starts with ( so aser inlines it as pre-serialized SX *)
String (Printf.sprintf "(\xc2\xabIO:%d\xc2\xbb)" id)
(* Return SxExpr so serialize/inspect passes it through unquoted *)
SxExpr (Printf.sprintf "(\xc2\xabIO:%d\xc2\xbb)" id)
end else begin
let args_str = String.concat " " (List.map serialize_value args) in
send (Printf.sprintf "(io-request \"%s\" %s)" name args_str);
@@ -539,6 +562,17 @@ let make_server_env () =
| [a; b] -> Bool (a == b)
| _ -> raise (Eval_error "identical?: expected 2 args"));
bind "make-sx-expr" (fun args ->
match args with
| [String s] -> SxExpr s
| _ -> raise (Eval_error "make-sx-expr: expected string"));
bind "sx-expr-source" (fun args ->
match args with
| [SxExpr s] -> String s
| [String s] -> String s
| _ -> raise (Eval_error "sx-expr-source: expected sx-expr or string"));
bind "make-continuation" (fun args ->
match args with
| [f] ->
@@ -760,7 +794,7 @@ let compile_adapter env =
(* Command dispatch *)
(* ====================================================================== *)
let dispatch env cmd =
let rec dispatch env cmd =
match cmd with
| List [Symbol "ping"] ->
send_ok_string "ocaml-cek"
@@ -792,6 +826,10 @@ let dispatch env cmd =
| Eval_error msg -> send_error msg
| exn -> send_error (Printexc.to_string exn))
| List [Symbol "eval-blob"] ->
let src = read_blob () in
dispatch env (List [Symbol "eval"; String src])
| List [Symbol "eval"; String src] ->
(try
let exprs = Sx_parser.parse_all src in
@@ -827,6 +865,16 @@ let dispatch env cmd =
| Eval_error msg -> send_error msg
| exn -> send_error (Printexc.to_string exn))
| List [Symbol "aser-blob"] ->
(* Like aser but reads source as a binary blob. *)
let src = read_blob () in
dispatch env (List [Symbol "aser"; String src])
| List [Symbol "aser-slot-blob"] ->
(* Like aser-slot but reads source as a binary blob. *)
let src = read_blob () in
dispatch env (List [Symbol "aser-slot"; String src])
| List [Symbol "aser"; String src] ->
(* Evaluate and serialize as SX wire format.
Calls the SX-defined aser function from adapter-sx.sx.
@@ -920,6 +968,12 @@ let dispatch env cmd =
Hashtbl.remove env.bindings "expand-components?";
send_error (Printexc.to_string exn))
| List (Symbol "sx-page-full-blob" :: shell_kwargs) ->
(* Like sx-page-full but reads page source as a length-prefixed blob
from the next line(s), avoiding string-escape round-trip issues. *)
let page_src = read_blob () in
dispatch env (List (Symbol "sx-page-full" :: String page_src :: shell_kwargs))
| List (Symbol "sx-page-full" :: String page_src :: shell_kwargs) ->
(* Full page render: aser-slot body + render-to-html shell in ONE call.
shell_kwargs are keyword pairs: :title "..." :csrf "..." etc.
@@ -1167,6 +1221,10 @@ let cli_mode mode =
let result = Sx_ref.eval_expr call (Env env) in
(match result with
| String s | SxExpr s -> print_string s
| Dict d when Hashtbl.mem d "__aser_sx" ->
(match Hashtbl.find d "__aser_sx" with
| String s | SxExpr s -> print_string s
| v -> print_string (serialize_value v))
| _ -> print_string (serialize_value result));
flush stdout
| "aser-slot" ->
@@ -1180,6 +1238,10 @@ let cli_mode mode =
let result = Sx_ref.eval_expr call (Env env) in
(match result with
| String s | SxExpr s -> print_string s
| Dict d when Hashtbl.mem d "__aser_sx" ->
(match Hashtbl.find d "__aser_sx" with
| String s | SxExpr s -> print_string s
| v -> print_string (serialize_value v))
| _ -> print_string (serialize_value result));
flush stdout
| _ ->

View File

@@ -393,7 +393,18 @@ let rec inspect = function
| Number n ->
if Float.is_integer n then Printf.sprintf "%d" (int_of_float n)
else Printf.sprintf "%g" n
| String s -> Printf.sprintf "%S" s
| String s ->
let buf = Buffer.create (String.length s + 2) in
Buffer.add_char buf '"';
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.add_char buf '"';
Buffer.contents buf
| Symbol s -> s
| Keyword k -> ":" ^ k
| List items | ListRef { contents = items } ->