coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

Restore hyperscript work on stable site base (908f4f80)

Browse Source 
Reset to last known-good state (908f4f80) where links, stepper, and
islands all work, then recovered all hyperscript implementation,
conformance tests, behavioral tests, Playwright specs, site sandbox,
IO-aware server loading, and upstream test suite from f271c88a.

Excludes runtime changes (VM resolve hook, VmSuspended browser handler,
sx_ref.ml guard recovery) that need careful re-integration.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-09 19:29:56 +00:00
parent 908f4f80d4
commit 7492ceac4e
55 changed files with 32933 additions and 437 deletions
Download Patch File Download Diff File Expand all files Collapse all files

171
hosts/ocaml/bin/sx_server.ml
View File

@@ -315,12 +315,12 @@ let resolve_library_path lib_spec =
The file should contain a define-library form that registers itself. *)
let _import_env : env option ref = ref None
let load_library_file path =
(* Use eval_expr which has the cek_run import patch — handles nested imports *)
let rec load_library_file path =
(* Use eval_expr_io for IO-aware loading (handles nested imports) *)
let env = match !_import_env with Some e -> e | None -> Sx_types.make_env () in
let exprs = Sx_parser.parse_file path in
List.iter (fun expr ->
try ignore (Sx_ref.eval_expr expr (Env env))
try ignore (eval_expr_io expr (Env env))
with Eval_error msg ->
Printf.eprintf "[load-library] %s: %s\n%!" (Filename.basename path) msg
) exprs
@@ -328,7 +328,7 @@ let load_library_file path =
(** IO-aware CEK run — handles suspension by dispatching IO requests.
Import requests are handled locally (load .sx file).
Other IO requests are sent to the Python bridge. *)
let cek_run_with_io state =
and cek_run_with_io state =
let s = ref state in
let is_terminal s = match Sx_ref.cek_terminal_p s with Bool true -> true | _ -> false in
let is_suspended s = match Sx_runtime.get_val s (String "phase") with String "io-suspended" -> true | _ -> false in
@@ -368,7 +368,7 @@ let cek_run_with_io state =
loop ()
(** IO-aware eval_expr — like eval_expr but handles IO suspension. *)
let _eval_expr_io expr env =
and eval_expr_io expr env =
let state = Sx_ref.make_cek_state expr env (List []) in
cek_run_with_io state
@@ -1009,7 +1009,7 @@ let rec dispatch env cmd =
ignore (Sx_types.env_bind env "*current-file*" (String path));
let count = ref 0 in
List.iter (fun expr ->
ignore (Sx_ref.eval_expr expr (Env env));
ignore (eval_expr_io expr (Env env));
incr count
) exprs;
(* Rebind host extension points after .sx load — evaluator.sx
@@ -2223,7 +2223,7 @@ let http_load_files env files =
try
let exprs = Sx_parser.parse_file path in
List.iter (fun expr ->
try ignore (Sx_ref.eval_expr expr (Env env))
try ignore (eval_expr_io expr (Env env))
with e -> Printf.eprintf "[http-load] %s: %s\n%!" (Filename.basename path) (Printexc.to_string e)
) exprs
with e -> Printf.eprintf "[http-load] parse error %s: %s\n%!" path (Printexc.to_string e)
@@ -3175,6 +3175,162 @@ let http_mode port =
Array.iter Domain.join workers)
(* --site mode: full site env (same setup as HTTP) + epoch protocol on stdin/stdout.
No HTTP server, no ports. Used by Playwright sandbox tests to render pages
as a pure function: URL → HTML via the render-page epoch command. *)
let site_mode () =
let env = make_server_env () in
http_setup_declarative_stubs env;
http_setup_platform_constructors env;
http_setup_page_helpers env;
(* Load all .sx files — same as http_mode *)
let project_dir = try Sys.getenv "SX_PROJECT_DIR" with Not_found ->
Sys.getcwd () in
let spec_base = project_dir ^ "/spec" in
let lib_base = project_dir ^ "/lib" in
let web_base = project_dir ^ "/web" in
let shared_sx = try Sys.getenv "SX_SHARED_DIR" with Not_found ->
let docker_path = project_dir ^ "/shared_sx" in
let dev_path = project_dir ^ "/shared/sx/templates" in
if Sys.file_exists docker_path then docker_path else dev_path in
let sx_sx = try Sys.getenv "SX_COMPONENTS_DIR" with Not_found ->
let docker_path = project_dir ^ "/components" in
let dev_path = project_dir ^ "/sx/sx" in
if Sys.file_exists docker_path then docker_path else dev_path in
let static_dir = try Sys.getenv "SX_STATIC_DIR" with Not_found ->
let docker_path = project_dir ^ "/static" in
let dev_path = project_dir ^ "/shared/static" in
if Sys.file_exists docker_path then docker_path else dev_path in
ignore (env_bind env "_project-dir" (String project_dir));
ignore (env_bind env "_spec-dir" (String spec_base));
ignore (env_bind env "_lib-dir" (String lib_base));
ignore (env_bind env "_web-dir" (String web_base));
_import_env := Some env;
let core_files = [
spec_base ^ "/parser.sx"; spec_base ^ "/render.sx"; spec_base ^ "/signals.sx";
lib_base ^ "/compiler.sx";
web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
web_base ^ "/io.sx"; web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
web_base ^ "/request-handler.sx"; web_base ^ "/page-helpers.sx";
] in
http_load_files env core_files;
let skip_files = ["primitives.sx"; "types.sx"; "boundary.sx";
"harness.sx"; "eval-rules.sx"; "vm-inline.sx"] in
let skip_dirs = ["tests"; "test"; "plans"; "essays"; "spec"; "client-libs"] in
let rec load_dir dir =
if Sys.file_exists dir && Sys.is_directory dir then begin
let entries = Sys.readdir dir in
Array.sort String.compare entries;
Array.iter (fun f ->
let path = dir ^ "/" ^ f in
if Sys.is_directory path then begin
if not (List.mem f skip_dirs) then load_dir path
end
else if Filename.check_suffix f ".sx"
&& not (List.mem f skip_files)
&& not (String.length f > 5 && String.sub f 0 5 = "test-")
&& not (Filename.check_suffix f ".test.sx") then
http_load_files env [path]
) entries
end
in
load_dir lib_base;
load_dir shared_sx;
let sx_sxc = try Sys.getenv "SX_SXC_DIR" with Not_found ->
let docker_path = project_dir ^ "/sxc" in
let dev_path = project_dir ^ "/sx/sxc" in
if Sys.file_exists docker_path then docker_path else dev_path in
load_dir sx_sxc;
load_dir sx_sx;
(* IO registry + app config *)
(try match env_get env "__io-registry" with
| Dict registry ->
let batchable = Hashtbl.fold (fun name entry acc ->
match entry with
| Dict d -> (match Hashtbl.find_opt d "batchable" with
| Some (Bool true) -> name :: acc | _ -> acc)
| _ -> acc) registry [] in
if batchable <> [] then batchable_helpers := batchable
| _ -> ()
with _ -> ());
(try match env_get env "__app-config" with
| Dict d -> _app_config := Some d
| _ -> ()
with _ -> ());
(* SSR overrides *)
let bind name fn = ignore (env_bind env name (NativeFn (name, fn))) in
bind "effect" (fun _args -> Nil);
bind "register-in-scope" (fun _args -> Nil);
rebind_host_extensions env;
ignore (env_bind env "assoc" (NativeFn ("assoc", fun args ->
match args with
| Dict d :: rest ->
let d2 = Hashtbl.copy d in
let rec go = function
| [] -> Dict d2
| String k :: v :: rest -> Hashtbl.replace d2 k v; go rest
| Keyword k :: v :: rest -> Hashtbl.replace d2 k v; go rest
| _ -> raise (Eval_error "assoc: pairs")
in go rest
| _ -> raise (Eval_error "assoc: dict + pairs"))));
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
(* Shell statics for render-page *)
http_inject_shell_statics env static_dir sx_sxc;
(* No JIT in site mode — the lazy JIT hook can loop on complex ASTs
(known bug: project_jit_bytecode_bug.md). Pure CEK is slower but
correct. First renders take ~2-5s, subsequent ~0.5-1s with caching. *)
Printf.eprintf "[site] Ready — epoch protocol on stdin/stdout\n%!";
send "(ready)";
(* nav-urls helper — walk sx-nav-tree, collect (href label) pairs *)
let nav_urls () =
let tree = env_get env "sx-nav-tree" in
let urls = ref [] in
let rec walk node = match node with
| Dict d ->
let href = match Hashtbl.find_opt d "href" with Some (String s) -> s | _ -> "" in
let label = match Hashtbl.find_opt d "label" with Some (String s) -> s | _ -> "" in
if href <> "" then urls := (href, label) :: !urls;
(match Hashtbl.find_opt d "children" with
| Some (List items) | Some (ListRef { contents = items }) ->
List.iter walk items
| _ -> ())
| _ -> ()
in
walk tree;
let items = List.rev !urls in
"(" ^ String.concat " " (List.map (fun (h, l) ->
Printf.sprintf "(\"%s\" \"%s\")" (escape_sx_string h) (escape_sx_string l)
) items) ^ ")"
in
(* Epoch protocol loop *)
(try
while true do
match read_line_blocking () with
| None -> exit 0
| Some line ->
let line = String.trim line in
if line = "" then ()
else begin
let exprs = Sx_parser.parse_all line in
match exprs with
| [List [Symbol "epoch"; Number n]] ->
current_epoch := int_of_float n
(* 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
| 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 *)
| [List [Symbol "nav-urls"]] ->
(try send_ok_raw (nav_urls ())
with e -> send_error ("nav-urls: " ^ Printexc.to_string e))
| [cmd] -> dispatch env cmd
| _ -> send_error ("Expected single command, got " ^ string_of_int (List.length exprs))
end
done
with End_of_file -> ())
let () =
(* Check for CLI mode flags *)
let args = Array.to_list Sys.argv in
@@ -3182,6 +3338,7 @@ let () =
else 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 if List.mem "--site" args then site_mode ()
else if List.mem "--http" args then begin
(* Extract port: --http PORT *)
let port = ref 8014 in