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

Restore OCaml to 5c8b05a + Docker native server entrypoint

Browse Source 
All OCaml files restored to the last known working state (5c8b05a).
All SX changes preserved and verified working with native server.
Docker compose updated to run sx_server.exe --http directly.

859KB homepage renders, 7/9 pages cached, ~30s startup (JIT fallback).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-29 22:35:40 +00:00
parent a38b5a9b44
commit 07f5d03ac1
3 changed files with 159 additions and 80 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
docker-compose.dev-sx.yml
View File

@@ -19,6 +19,8 @@ services:
SX_BOUNDARY_STRICT: "1"
SX_DEV: "1"
OCAMLRUNPARAM: "b"
entrypoint: ["/app/bin/sx_server", "--http", "8000"]
working_dir: /app
ports:
- "8013:8000"
volumes:

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

@@ -390,22 +390,6 @@ let make_test_env () =
bind "defeffect" (fun _args -> Nil);
(* --- Primitives for canonical.sx / content tests --- *)
bind "symbol-name" (fun args ->
match args with
| [Symbol s] -> String s
| _ -> raise (Eval_error "symbol-name: expected symbol"));
bind "keyword-name" (fun args ->
match args with
| [Keyword k] -> String k
| _ -> raise (Eval_error "keyword-name: expected keyword"));
bind "trim-right" (fun args ->
match args with
| [String s] ->
let len = String.length s in
let i = ref (len - 1) in
while !i >= 0 && (s.[!i] = ' ' || s.[!i] = '\t' || s.[!i] = '\n' || s.[!i] = '\r') do decr i done;
String (String.sub s 0 (!i + 1))
| _ -> raise (Eval_error "trim-right: expected string"));
bind "contains-char?" (fun args ->
match args with
| [String s; String c] when String.length c = 1 ->
@@ -825,8 +809,6 @@ let run_spec_tests env test_files =
with e -> Printf.eprintf "Warning: %s: %s\n%!" name (Printexc.to_string e))
end
in
(* Content-addressing, serialization *)
load_module "canonical.sx" spec_dir;
(* Render adapter for test-render-html.sx *)
load_module "render.sx" spec_dir;
load_module "adapter-html.sx" web_dir;

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

@@ -1421,19 +1421,6 @@ let test_mode () =
(* HTTP server mode (--http PORT) *)
(* ====================================================================== *)
(** Parse HTTP headers from raw request data into (key, value) list. *)
let parse_http_headers data =
let lines = String.split_on_char '\n' data in
List.filter_map (fun line ->
let line = String.trim line in
match String.index_opt line ':' with
| Some i when i > 0 ->
let key = String.lowercase_ascii (String.trim (String.sub line 0 i)) in
let value = String.trim (String.sub line (i + 1) (String.length line - i - 1)) in
Some (key, value)
| _ -> None
) (List.tl lines) (* skip request line *)
let http_response ?(status=200) ?(content_type="text/html; charset=utf-8") body =
let status_text = match status with
| 200 -> "OK" | 301 -> "Moved Permanently" | 304 -> "Not Modified"
@@ -1474,36 +1461,142 @@ let url_decode s =
done;
Buffer.contents buf
(** Render a page by calling the configured SX request handler.
The handler function receives path, headers dict, and env.
All routing, layout, and response format logic lives in SX.
The handler function name is configurable via SX_REQUEST_HANDLER env var. *)
let http_render_page env path headers =
(** Render a page from an SX URL path. Returns HTML or None. *)
let http_render_page env path =
let t0 = Unix.gettimeofday () in
let handler_name = try Sys.getenv "SX_REQUEST_HANDLER"
with Not_found -> "sx-handle-request" in
try
let handler = env_get env handler_name in
(* Build headers dict for SX *)
let headers_dict = Hashtbl.create 8 in
List.iter (fun (k, v) -> Hashtbl.replace headers_dict k (String v)) headers;
let result = Sx_ref.cek_call handler
(List [String path; Dict headers_dict; Env env]) in
(* Parse the URL path to an SX expression *)
let path_expr =
if path = "/" || path = "/sx/" || path = "/sx" then "home"
else begin
let p = if String.length path > 4 && String.sub path 0 4 = "/sx/" then
String.sub path 4 (String.length path - 4)
else if String.length path > 1 && path.[0] = '/' then
String.sub path 1 (String.length path - 1)
else path
in
(* URL convention: dots → spaces *)
String.map (fun c -> if c = '.' then ' ' else c) p
end
in
(* Auto-quote unknown symbols as strings (slug parameters).
e.g. (etc (plan sx-host)) → (etc (plan "sx-host"))
Matches Python's prepare_url_expr behavior. *)
let rec auto_quote expr =
match expr with
| Symbol s when not (env_has env s) && (try ignore (Sx_primitives.get_primitive s); false with _ -> true) ->
String s
| List items -> List (List.map auto_quote items)
| ListRef { contents = items } -> List (List.map auto_quote items)
| _ -> expr
in
(* Evaluate page function to get component call *)
let page_ast =
try
let exprs = Sx_parser.parse_all path_expr in
let expr = match exprs with [e] -> e | _ -> List exprs in
let quoted = auto_quote expr in
(* Bare symbols (like "home") → wrap in list to call as function.
e.g. home → (home), geography → (geography) *)
let callable = match quoted with
| Symbol _ -> List [quoted]
| _ -> quoted in
Sx_ref.eval_expr callable (Env env)
with e ->
Printf.eprintf "[http-route] eval failed for '%s': %s\n%!" path_expr (Printexc.to_string e);
Nil
in
if page_ast = Nil then None
else begin
(* Wrap: (~layouts/doc :path "/sx/..." content) → (~shared:layout/app-body :content wrapped) *)
let nav_path = if String.length path >= 4 && String.sub path 0 4 = "/sx/" then path
else "/sx" ^ path in
let wrapped = List [
Symbol "~layouts/doc"; Keyword "path"; String nav_path; page_ast
] in
let full_ast = List [
Symbol "~shared:layout/app-body"; Keyword "content"; wrapped
] in
let page_source = serialize_value full_ast in
let t1 = Unix.gettimeofday () in
(match result with
| Nil -> Printf.eprintf "[sx-http] %s → nil (%.3fs)\n%!" path (t1 -. t0); None
| String s | RawHTML s ->
Printf.eprintf "[sx-http] %s → %d bytes (%.3fs)\n%!" path (String.length s) (t1 -. t0);
Some s
| _ ->
let s = Sx_runtime.value_to_str result in
Printf.eprintf "[sx-http] %s → %d bytes (%.3fs)\n%!" path (String.length s) (t1 -. t0);
Some s)
with
| Eval_error msg ->
Printf.eprintf "[sx-http] %s handler error: %s\n%!" path msg; None
| Not_found ->
Printf.eprintf "[sx-http] handler '%s' not found in env\n%!" handler_name; None
(* Phase 1: aser — expand all components server-side.
expand-components? is pre-bound at startup (always true in HTTP mode). *)
let body_result =
let call = List [Symbol "aser"; List [Symbol "quote"; full_ast]; Env env] in
Sx_ref.eval_expr call (Env env)
in
let body_str = match body_result with
| String s | SxExpr s -> s
| _ -> serialize_value body_result
in
let t2 = Unix.gettimeofday () in
(* Phase 2: SSR — render to HTML using the SX adapter (render-to-html
from adapter-html.sx) via the CEK evaluator. This handles reactive
primitives (signals, deref, computed) correctly for island SSR.
Falls back to native Sx_render if the SX adapter isn't available. *)
let body_html =
try
let body_exprs = Sx_parser.parse_all body_str in
let body_expr = match body_exprs with
| [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs) in
if env_has env "render-to-html" then begin
(* SX adapter — handles signals, islands, CSSX *)
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; body_expr];
Env env] in
let result = Sx_ref.eval_expr render_call (Env env) in
match result with
| String s | RawHTML s -> s
| _ -> Sx_runtime.value_to_str result
end else
(* Fallback: native renderer *)
Sx_render.sx_render_to_html env body_expr env
with e ->
Printf.eprintf "[http-ssr] failed for %s: %s\n%!" path (Printexc.to_string e); ""
in
let t3 = Unix.gettimeofday () in
(* Phase 3: Shell — render directly to buffer for zero-copy output *)
let get_shell_var name = try env_get env ("__shell-" ^ name) with _ -> Nil in
let shell_args = [
Keyword "title"; String "SX";
Keyword "csrf"; String "";
Keyword "page-sx"; String page_source;
Keyword "body-html"; String body_html;
Keyword "component-defs"; get_shell_var "component-defs";
Keyword "component-hash"; get_shell_var "component-hash";
Keyword "pages-sx"; get_shell_var "pages-sx";
Keyword "sx-css"; get_shell_var "sx-css";
Keyword "sx-css-classes"; get_shell_var "sx-css-classes";
Keyword "asset-url"; get_shell_var "asset-url";
Keyword "sx-js-hash"; get_shell_var "sx-js-hash";
Keyword "body-js-hash"; get_shell_var "body-js-hash";
Keyword "wasm-hash"; get_shell_var "wasm-hash";
Keyword "head-scripts"; get_shell_var "head-scripts";
Keyword "body-scripts"; get_shell_var "body-scripts";
Keyword "inline-css"; get_shell_var "inline-css";
Keyword "inline-head-js"; get_shell_var "inline-head-js";
Keyword "init-sx"; get_shell_var "init-sx";
Keyword "use-wasm"; Bool (try Sys.getenv "SX_USE_WASM" = "1" with Not_found -> false);
Keyword "meta-html"; String "";
] in
let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in
(* Use SX adapter for shell too — it's an SX component *)
let html =
if env_has env "render-to-html" then begin
let render_call = List [Symbol "render-to-html";
List [Symbol "quote"; shell_call];
Env env] in
let result = Sx_ref.eval_expr render_call (Env env) in
match result with
| String s | RawHTML s -> s
| _ -> Sx_runtime.value_to_str result
end else
Sx_render.sx_render_to_html env shell_call env
in
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
end
(* ====================================================================== *)
(* Static file serving + file hashing *)
@@ -1831,7 +1924,6 @@ let http_mode port =
lib_base ^ "/compiler.sx";
web_base ^ "/adapter-html.sx"; web_base ^ "/adapter-sx.sx";
web_base ^ "/web-forms.sx"; web_base ^ "/engine.sx";
web_base ^ "/request-handler.sx";
] in
http_load_files env core_files;
(* Libraries *)
@@ -1936,7 +2028,7 @@ let http_mode port =
let response_cache : (string, string) Hashtbl.t = Hashtbl.create 128 in
let cache_response path =
match http_render_page env path [] with
match http_render_page env path with
| Some html ->
let resp = http_response html in
Hashtbl.replace response_cache path resp;
@@ -1971,6 +2063,18 @@ let http_mode port =
(try Unix.close client with _ -> ())
in
(* Check if request has SX-Request or HX-Request header (AJAX navigation) *)
let is_sx_request data =
let lower = String.lowercase_ascii data in
let has_substring s sub =
let slen = String.length s and sublen = String.length sub in
if sublen > slen then false
else let rec check i = if i > slen - sublen then false
else if String.sub s i sublen = sub then true else check (i + 1)
in check 0
in
has_substring lower "sx-request" || has_substring lower "hx-request"
in
(* Non-blocking event loop with render worker pool.
- Main loop: Unix.select on listen socket + all connected clients
@@ -1981,7 +2085,7 @@ let http_mode port =
let n_workers = max 2 (Domain.recommended_domain_count ()) in
(* Render queue: for cache misses that need full page render *)
let render_queue : (Unix.file_descr * string * (string * string) list) list ref = ref [] in
let render_queue : (Unix.file_descr * string) list ref = ref [] in
let render_mutex = Mutex.create () in
let render_cond = Condition.create () in
let shutdown = ref false in
@@ -2002,14 +2106,13 @@ let http_mode port =
w
in
match work with
| Some (fd, path, headers) ->
| Some (fd, path) ->
let response =
try
let is_ajax = List.exists (fun (k, _) -> k = "sx-request" || k = "hx-request") headers in
match http_render_page env path headers with
match http_render_page env path with
| Some html ->
let resp = http_response ~content_type:"text/html; charset=utf-8" html in
if not is_ajax then Hashtbl.replace response_cache path resp;
let resp = http_response html in
Hashtbl.replace response_cache path resp;
resp
| None -> http_response ~status:404 "<h1>Not Found</h1>"
with e ->
@@ -2037,22 +2140,12 @@ let http_mode port =
let is_sx = path = "/sx/" || path = "/sx"
|| (String.length path > 4 && String.sub path 0 4 = "/sx/") in
if is_sx then begin
let headers = parse_http_headers data in
let is_ajax = List.exists (fun (k, _) -> k = "sx-request" || k = "hx-request") headers in
if is_ajax then begin
(* AJAX — always render fresh via SX handler (decides format) *)
Mutex.lock render_mutex;
render_queue := !render_queue @ [(fd, path, headers)];
Condition.signal render_cond;
Mutex.unlock render_mutex;
false
end else
(* Full page — serve from cache *)
(* Serve from cache (full page) — client handles sx-select extraction *)
match Hashtbl.find_opt response_cache path with
| Some cached -> write_response fd cached; true
| None ->
Mutex.lock render_mutex;
render_queue := !render_queue @ [(fd, path, headers)];
render_queue := !render_queue @ [(fd, path)];
Condition.signal render_cond;
Mutex.unlock render_mutex;
false
@@ -2085,8 +2178,10 @@ let http_mode port =
let n = try Unix.read client buf 0 8192 with _ -> 0 in
if n > 0 then begin
let data = Bytes.sub_string buf 0 n in
let is_ajax = is_sx_request data in
if is_ajax then Printf.eprintf "[sx-http] AJAX request detected\n%!";
let handled =
try fast_handle client data false
try fast_handle client data is_ajax
with e ->
Printf.eprintf "[sx-http] Error: %s\n%!" (Printexc.to_string e);
write_response client (http_response ~status:500 "<h1>Internal Server Error</h1>");