VM aser-slot → sx-page-full: single-call page render, 0.55s warm

Compiler fixes:
- Upvalue re-lookup returns own position (uv-index), not parent slot
- Spec: cek-call uses (make-env) not (dict) — OCaml Dict≠Env
- Bootstrap post-processes transpiler Dict→Env for cek_call

VM runtime fixes:
- compile_adapter evaluates constant defines (SPECIAL_FORM_NAMES etc.)
  via execute_module instead of wrapping as NativeFn closures
- Native primitives: map-indexed, some, every?
- Nil-safe HO forms: map/filter/for-each/some/every? accept nil as empty
- expand-components? set in kernel env (not just VM globals)
- unwrap_env diagnostic: reports actual type received

sx-page-full command:
- Single OCaml call: aser-slot body + render-to-html shell
- Eliminates two pipe round-trips (was: aser-slot→Python→shell render)
- Shell statics (component_defs, CSS, pages_sx) cached in Python,
  injected into kernel once, referenced by symbol in per-request command
- Large blobs use placeholder tokens — Python splices post-render,
  pipe transfers ~51KB instead of 2MB

Performance (warm):
- Server total: 0.55s (was ~2s)
- aser-slot VM: 0.3s, shell render: 0.01s, pipe: 0.06s
- kwargs computation: 0.000s (cached)

SX_STANDALONE mode for sx_docs dev (skips fragment fetches).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-20 11:06:04 +00:00
parent 8dd3eaa1d9
commit ae0e87fbf8
13 changed files with 477 additions and 149 deletions

View File

@@ -697,38 +697,36 @@ let compile_adapter env =
(Array.length outer_code.Sx_vm.constants)
(if Array.length outer_code.Sx_vm.constants > 0 then
type_of outer_code.Sx_vm.constants.(0) else "empty");
(* The compiled define body is (fn ...) which compiles to
OP_CLOSURE + [upvalue descriptors] + OP_RETURN.
Extract the inner code object from constants[idx]. *)
let code =
let bc = outer_code.Sx_vm.bytecode in
if Array.length bc >= 4 && bc.(0) = 51 then begin
let idx = bc.(1) lor (bc.(2) lsl 8) in
let bc = outer_code.Sx_vm.bytecode in
if Array.length bc >= 4 && bc.(0) = 51 then begin
(* The compiled define body is (fn ...) which compiles to
OP_CLOSURE + [upvalue descriptors] + OP_RETURN.
Extract the inner code object from constants[idx]. *)
let idx = bc.(1) lor (bc.(2) lsl 8) in
let code =
if idx < Array.length outer_code.Sx_vm.constants then begin
let inner_val = outer_code.Sx_vm.constants.(idx) in
try Sx_vm.code_from_value inner_val
with e ->
Printf.eprintf "[vm] inner code_from_value failed for %s: %s\n%!"
name (Printexc.to_string e);
Printf.eprintf "[vm] inner val type: %s\n%!" (type_of inner_val);
(match inner_val with
| Dict d ->
Printf.eprintf "[vm] inner keys: %s\n%!"
(String.concat ", " (Hashtbl.fold (fun k _ acc -> k::acc) d []));
(match Hashtbl.find_opt d "bytecode" with
| Some v -> Printf.eprintf "[vm] bytecode type: %s\n%!" (type_of v)
| None -> Printf.eprintf "[vm] NO bytecode key\n%!")
| _ -> ());
raise e
end else outer_code
end else outer_code
in
let cl = { Sx_vm.code; upvalues = [||]; name = Some name;
env_ref = globals } in
Hashtbl.replace globals name
(NativeFn ("vm:" ^ name, fun args ->
Sx_vm.call_closure cl args globals));
incr compiled
in
let cl = { Sx_vm.code; upvalues = [||]; name = Some name;
env_ref = globals } in
Hashtbl.replace globals name
(NativeFn ("vm:" ^ name, fun args ->
Sx_vm.call_closure cl args globals));
incr compiled
end else begin
(* Not a lambda — constant expression (e.g. (list ...)).
Execute once and store the resulting value directly. *)
let value = Sx_vm.execute_module outer_code globals in
Hashtbl.replace globals name value;
Printf.eprintf "[vm] %s: constant (type=%s)\n%!" name (type_of value);
incr compiled
end
| _ -> () (* non-dict result — skip *)
with e ->
Printf.eprintf "[vm] FAIL adapter %s: %s\n%!" name (Printexc.to_string e))
@@ -861,11 +859,11 @@ let dispatch env cmd =
io_queue := [];
io_counter := 0;
let t0 = Unix.gettimeofday () in
let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
ignore (env_bind env "expand-components?" expand_fn);
let result = match !vm_adapter_globals with
| Some globals ->
(* VM path: call compiled aser directly *)
Hashtbl.replace globals "expand-components?"
(NativeFn ("expand-components?", fun _args -> Bool true));
Hashtbl.replace globals "expand-components?" expand_fn;
let aser_fn = try Hashtbl.find globals "aser"
with Not_found -> raise (Eval_error "VM: aser not compiled") in
let r = match aser_fn with
@@ -875,15 +873,10 @@ let dispatch env cmd =
Hashtbl.remove globals "expand-components?";
r
| None ->
(* CEK fallback *)
ignore (env_bind env "expand-components?"
(NativeFn ("expand-components?", fun _args -> Bool true)));
let call = List [Symbol "aser";
List [Symbol "quote"; expr];
Env env] in
let r = Sx_ref.eval_expr call (Env env) in
Hashtbl.remove env.bindings "expand-components?";
r
Sx_ref.eval_expr call (Env env)
in
let t1 = Unix.gettimeofday () in
io_batch_mode := false;
@@ -911,6 +904,78 @@ let dispatch env cmd =
Hashtbl.remove env.bindings "expand-components?";
send_error (Printexc.to_string exn))
| 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.
These are passed directly to ~shared:shell/sx-page-shell. *)
(try
(* Phase 1: aser-slot the page body *)
let exprs = Sx_parser.parse_all page_src in
let expr = match exprs with
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs)
in
io_batch_mode := true;
io_queue := [];
io_counter := 0;
let t0 = Unix.gettimeofday () in
let expand_fn = NativeFn ("expand-components?", fun _args -> Bool true) in
ignore (env_bind env "expand-components?" expand_fn);
let body_result = match !vm_adapter_globals with
| Some globals ->
Hashtbl.replace globals "expand-components?" expand_fn;
let aser_fn = try Hashtbl.find globals "aser"
with Not_found -> raise (Eval_error "VM: aser not compiled") in
let r = match aser_fn with
| NativeFn (_, fn) -> fn [expr; Env env]
| _ -> raise (Eval_error "VM: aser not a function")
in
Hashtbl.remove globals "expand-components?";
r
| None ->
let call = List [Symbol "aser";
List [Symbol "quote"; expr];
Env env] in
Sx_ref.eval_expr call (Env env)
in
let t1 = Unix.gettimeofday () in
io_batch_mode := false;
Hashtbl.remove env.bindings "expand-components?";
let body_str = match body_result with
| String s | SxExpr s -> s
| _ -> serialize_value body_result
in
let body_final = flush_batched_io body_str in
let t2 = Unix.gettimeofday () in
(* Phase 2: render shell with body + all kwargs.
Resolve symbol references (e.g. __shell-component-defs) to their
values from the env — these were pre-injected by the bridge. *)
let resolved_kwargs = List.map (fun v ->
match v with
| Symbol s ->
(try env_get env s
with _ -> try Sx_primitives.get_primitive s with _ -> v)
| _ -> v
) shell_kwargs in
let shell_args = Keyword "page-sx" :: String body_final :: resolved_kwargs in
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
let html = Sx_render.render_to_html shell_call env in
let t3 = Unix.gettimeofday () in
Printf.eprintf "[sx-page-full] aser=%.3fs io=%.3fs shell=%.3fs total=%.3fs body=%d html=%d\n%!"
(t1 -. t0) (t2 -. t1) (t3 -. t2) (t3 -. t0)
(String.length body_final) (String.length html);
send_ok_string html
with
| Eval_error msg ->
io_batch_mode := false;
io_queue := [];
Hashtbl.remove env.bindings "expand-components?";
send_error msg
| exn ->
io_batch_mode := false;
io_queue := [];
Hashtbl.remove env.bindings "expand-components?";
send_error (Printexc.to_string exn))
| List [Symbol "render"; String src] ->
(try
let exprs = Sx_parser.parse_all src in