Non-blocking batch IO for OCaml kernel + stable component hash
OCaml kernel (sx_server.ml): - Batch IO mode for aser-slot: batchable helpers (highlight, component-source) return placeholders during evaluation instead of blocking on stdin. After aser completes, all batched requests are flushed to Python at once. - Python processes them concurrently with asyncio.gather. - Placeholders (using «IO:N» markers) are replaced with actual values in the result string. - Non-batchable IO (query, action, ctx, request-arg) still uses blocking mode — their results drive control flow. Python bridge (ocaml_bridge.py): - _read_until_ok handles batched protocol: collects io-request lines with numeric IDs, processes on (io-done N) with gather. - IO result cache for pure helpers — eliminates redundant calls. - _handle_io_request strips batch ID from request format. Component caching (jinja_bridge.py): - Hash computed from FULL component env (all names + bodies), not per-page subset. Stable across all pages — browser caches once, no re-download on navigation between pages. - invalidate_component_hash() called on hot-reload. Tests: 15/15 OCaml helper tests pass (2 new batch IO tests). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -80,22 +80,96 @@ let read_line_blocking () =
|
||||
try Some (input_line stdin)
|
||||
with End_of_file -> None
|
||||
|
||||
(** Send an io-request and block until io-response arrives. *)
|
||||
(** 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 []
|
||||
let io_counter = ref 0
|
||||
|
||||
(** Helpers safe to defer — pure functions whose results are only used
|
||||
as rendering output (inlined into SX wire format), not in control flow. *)
|
||||
let batchable_helpers = [
|
||||
"highlight"; "component-source"
|
||||
]
|
||||
|
||||
let is_batchable name args =
|
||||
name = "helper" &&
|
||||
match args with
|
||||
| String h :: _ -> List.mem h batchable_helpers
|
||||
| _ -> false
|
||||
|
||||
(** Send an io-request — batch mode returns placeholder, else blocks. *)
|
||||
let io_request name args =
|
||||
let args_str = String.concat " " (List.map serialize_value args) in
|
||||
send (Printf.sprintf "(io-request \"%s\" %s)" name args_str);
|
||||
(* Block on stdin for io-response *)
|
||||
match read_line_blocking () with
|
||||
| None -> raise (Eval_error "IO bridge: stdin closed while waiting for io-response")
|
||||
| Some line ->
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
match exprs with
|
||||
| [List [Symbol "io-response"; value]] -> value
|
||||
| [List (Symbol "io-response" :: values)] ->
|
||||
(match values with
|
||||
| [v] -> v
|
||||
| _ -> List values)
|
||||
| _ -> raise (Eval_error ("IO bridge: unexpected response: " ^ line))
|
||||
if !io_batch_mode && is_batchable name args then begin
|
||||
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)
|
||||
end else begin
|
||||
let args_str = String.concat " " (List.map serialize_value args) in
|
||||
send (Printf.sprintf "(io-request \"%s\" %s)" name args_str);
|
||||
(* Block on stdin for io-response *)
|
||||
match read_line_blocking () with
|
||||
| None -> raise (Eval_error "IO bridge: stdin closed while waiting for io-response")
|
||||
| Some line ->
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
match exprs with
|
||||
| [List [Symbol "io-response"; value]] -> value
|
||||
| [List (Symbol "io-response" :: values)] ->
|
||||
(match values with
|
||||
| [v] -> v
|
||||
| _ -> List values)
|
||||
| _ -> raise (Eval_error ("IO bridge: unexpected response: " ^ line))
|
||||
end
|
||||
|
||||
(** Flush batched IO: send all requests, read all responses, replace placeholders. *)
|
||||
let flush_batched_io result_str =
|
||||
let queue = List.rev !io_queue in
|
||||
io_queue := [];
|
||||
io_counter := 0;
|
||||
if queue = [] then result_str
|
||||
else begin
|
||||
(* Send all batched requests with IDs *)
|
||||
List.iter (fun (id, name, args) ->
|
||||
let args_str = String.concat " " (List.map serialize_value args) in
|
||||
send (Printf.sprintf "(io-request %d \"%s\" %s)" id name args_str)
|
||||
) queue;
|
||||
send (Printf.sprintf "(io-done %d)" (List.length queue));
|
||||
(* Read all responses and replace placeholders *)
|
||||
let final = ref result_str in
|
||||
List.iter (fun (id, _, _) ->
|
||||
match read_line_blocking () with
|
||||
| Some line ->
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
let value_str = match exprs with
|
||||
| [List [Symbol "io-response"; String s]]
|
||||
| [List [Symbol "io-response"; SxExpr s]] -> s
|
||||
| [List [Symbol "io-response"; v]] -> serialize_value v
|
||||
| _ -> "nil"
|
||||
in
|
||||
let placeholder = Printf.sprintf "(\xc2\xabIO:%d\xc2\xbb)" id in
|
||||
(* Replace all occurrences of this placeholder *)
|
||||
let plen = String.length placeholder in
|
||||
let buf = Buffer.create (String.length !final) in
|
||||
let pos = ref 0 in
|
||||
let s = !final in
|
||||
let slen = String.length s in
|
||||
while !pos <= slen - plen do
|
||||
if String.sub s !pos plen = placeholder then begin
|
||||
Buffer.add_string buf value_str;
|
||||
pos := !pos + plen
|
||||
end else begin
|
||||
Buffer.add_char buf s.[!pos];
|
||||
incr pos
|
||||
end
|
||||
done;
|
||||
if !pos < slen then
|
||||
Buffer.add_substring buf s !pos (slen - !pos);
|
||||
final := Buffer.contents buf
|
||||
| None -> raise (Eval_error "IO batch: stdin closed")
|
||||
) queue;
|
||||
!final
|
||||
end
|
||||
|
||||
(** Bind IO primitives into the environment. *)
|
||||
let setup_io_env env =
|
||||
@@ -642,6 +716,48 @@ let dispatch env cmd =
|
||||
| Eval_error msg -> send_error msg
|
||||
| exn -> send_error (Printexc.to_string exn))
|
||||
|
||||
| List [Symbol "aser-slot"; String src] ->
|
||||
(* Like aser but expands ALL components server-side, not just
|
||||
server-affinity ones. Uses batch IO mode: batchable helper
|
||||
calls (highlight etc.) return placeholders during evaluation,
|
||||
then all IO is flushed concurrently after the aser completes. *)
|
||||
(try
|
||||
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
|
||||
(* Enable batch IO mode *)
|
||||
io_batch_mode := true;
|
||||
io_queue := [];
|
||||
io_counter := 0;
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e
|
||||
| [] -> Nil
|
||||
| _ -> List (Symbol "<>" :: exprs)
|
||||
in
|
||||
let call = List [Symbol "aser";
|
||||
List [Symbol "quote"; expr];
|
||||
Env env] in
|
||||
let result = Sx_ref.eval_expr call (Env env) in
|
||||
io_batch_mode := false;
|
||||
Hashtbl.remove env.bindings "expand-components?";
|
||||
let result_str = match result with
|
||||
| String s | SxExpr s -> s
|
||||
| _ -> serialize_value result
|
||||
in
|
||||
(* Flush batched IO: send requests, receive responses, replace placeholders *)
|
||||
let final = flush_batched_io result_str in
|
||||
send (Printf.sprintf "(ok-raw %s)" final)
|
||||
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
|
||||
@@ -672,23 +788,117 @@ let dispatch env cmd =
|
||||
(* Main loop *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let () =
|
||||
(* ====================================================================== *)
|
||||
(* CLI mode — one-shot render/aser from stdin *)
|
||||
(* ====================================================================== *)
|
||||
|
||||
let cli_load_files env files =
|
||||
List.iter (fun path ->
|
||||
if Sys.file_exists path then begin
|
||||
let exprs = Sx_parser.parse_file path in
|
||||
List.iter (fun expr ->
|
||||
ignore (Sx_ref.eval_expr expr (Env env))
|
||||
) exprs
|
||||
end
|
||||
) files
|
||||
|
||||
let cli_mode mode =
|
||||
let env = make_server_env () in
|
||||
send "(ready)";
|
||||
(* Main command loop *)
|
||||
try
|
||||
while true do
|
||||
match read_line_blocking () with
|
||||
| None -> exit 0 (* stdin closed *)
|
||||
| Some line ->
|
||||
let line = String.trim line in
|
||||
if line = "" then () (* skip blank lines *)
|
||||
else begin
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
match exprs with
|
||||
| [cmd] -> dispatch env cmd
|
||||
| _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
|
||||
end
|
||||
done
|
||||
(* Load spec + adapter files for aser modes *)
|
||||
let base = try Sys.getenv "SX_SPEC_DIR" with Not_found -> "spec" in
|
||||
let web_base = try Sys.getenv "SX_WEB_DIR" with Not_found -> "web" in
|
||||
let spec_files = [
|
||||
Filename.concat base "parser.sx";
|
||||
Filename.concat base "render.sx";
|
||||
Filename.concat web_base "adapter-sx.sx";
|
||||
] in
|
||||
(if mode = "aser" || mode = "aser-slot" then
|
||||
cli_load_files env spec_files);
|
||||
(* Load any files passed via --load *)
|
||||
let load_files = ref [] in
|
||||
let args = Array.to_list Sys.argv in
|
||||
let rec scan = function
|
||||
| "--load" :: path :: rest -> load_files := path :: !load_files; scan rest
|
||||
| _ :: rest -> scan rest
|
||||
| [] -> ()
|
||||
in scan args;
|
||||
cli_load_files env (List.rev !load_files);
|
||||
(* Read SX from stdin *)
|
||||
let buf = Buffer.create 4096 in
|
||||
(try while true do
|
||||
let line = input_line stdin in
|
||||
Buffer.add_string buf line;
|
||||
Buffer.add_char buf '\n'
|
||||
done with End_of_file -> ());
|
||||
let src = String.trim (Buffer.contents buf) in
|
||||
if src = "" then exit 0;
|
||||
(try
|
||||
match mode with
|
||||
| "render" ->
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e | [] -> Nil | _ -> List (Symbol "do" :: exprs) in
|
||||
let html = Sx_render.render_to_html expr env in
|
||||
print_string html; flush stdout
|
||||
| "aser" ->
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
|
||||
let call = List [Symbol "aser";
|
||||
List [Symbol "quote"; expr];
|
||||
Env env] in
|
||||
let result = Sx_ref.eval_expr call (Env env) in
|
||||
(match result with
|
||||
| String s | SxExpr s -> print_string s
|
||||
| _ -> print_string (serialize_value result));
|
||||
flush stdout
|
||||
| "aser-slot" ->
|
||||
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
|
||||
let exprs = Sx_parser.parse_all src in
|
||||
let expr = match exprs with
|
||||
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: exprs) in
|
||||
let call = List [Symbol "aser";
|
||||
List [Symbol "quote"; expr];
|
||||
Env env] in
|
||||
let result = Sx_ref.eval_expr call (Env env) in
|
||||
(match result with
|
||||
| String s | SxExpr s -> print_string s
|
||||
| _ -> print_string (serialize_value result));
|
||||
flush stdout
|
||||
| _ ->
|
||||
Printf.eprintf "Unknown CLI mode: %s\n" mode; exit 1
|
||||
with
|
||||
| End_of_file -> ()
|
||||
| Eval_error msg ->
|
||||
Printf.eprintf "Error: %s\n" msg; exit 1
|
||||
| exn ->
|
||||
Printf.eprintf "Error: %s\n" (Printexc.to_string exn); exit 1)
|
||||
|
||||
|
||||
let () =
|
||||
(* Check for CLI mode flags *)
|
||||
let args = Array.to_list Sys.argv in
|
||||
if List.mem "--render" args then cli_mode "render"
|
||||
else if List.mem "--aser-slot" args then cli_mode "aser-slot"
|
||||
else if List.mem "--aser" args then cli_mode "aser"
|
||||
else begin
|
||||
(* Normal persistent server mode *)
|
||||
let env = make_server_env () in
|
||||
send "(ready)";
|
||||
(* Main command loop *)
|
||||
try
|
||||
while true do
|
||||
match read_line_blocking () with
|
||||
| None -> exit 0 (* stdin closed *)
|
||||
| Some line ->
|
||||
let line = String.trim line in
|
||||
if line = "" then () (* skip blank lines *)
|
||||
else begin
|
||||
let exprs = Sx_parser.parse_all line in
|
||||
match exprs with
|
||||
| [cmd] -> dispatch env cmd
|
||||
| _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
|
||||
end
|
||||
done
|
||||
with
|
||||
| End_of_file -> ()
|
||||
end
|
||||
|
||||
Reference in New Issue
Block a user