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

OCaml evaluator for page dispatch + handler aser, 83/83 Playwright tests

Browse Source 
Major architectural change: page function dispatch and handler execution
now go through the OCaml kernel instead of the Python bootstrapped evaluator.

OCaml integration:
- Page dispatch: bridge.eval() evaluates SX URL expressions (geography, marshes, etc.)
- Handler aser: bridge.aser() serializes handler responses as SX wire format
- _ensure_components loads all .sx files into OCaml kernel (spec, web adapter, handlers)
- defhandler/defpage registered as no-op special forms so handler files load
- helper IO primitive dispatches to Python page helpers + IO handlers
- ok-raw response format for SX wire format (no double-escaping)
- Natural list serialization in eval (no (list ...) wrapper)
- Clean pipe: _read_until_ok always sends io-response on error

SX adapter (aser):
- scope-emit!/scope-peek aliases to avoid CEK special form conflict
- aser-fragment/aser-call: strings starting with "(" pass through unserialized
- Registered cond-scheme?, is-else-clause?, primitive?, get-primitive in kernel
- random-int, parse-int as kernel primitives; json-encode, into via IO bridge

Handler migration:
- All IO calls converted to (helper "name" args...) pattern
- request-arg, request-form, state-get, state-set!, now, component-source etc.
- Fixed bare (effect ...) in island bodies leaking disposer functions as text
- Fixed lower-case → lower, ~search-results → ~examples/search-results

Reactive islands:
- sx-hydrate-islands called after client-side navigation swap
- force-dispose-islands-in for outerHTML swaps (clears hydration markers)
- clear-processed! platform primitive for re-hydration

Content restructuring:
- Design, event bridge, named stores, phase 2 consolidated into reactive overview
- Marshes split into overview + 5 example sub-pages
- Nav links use sx-get/sx-target for client-side navigation

Playwright test suite (sx/tests/test_demos.py):
- 83 tests covering hypermedia demos, reactive islands, marshes, spec explorer
- Server-side rendering, handler interactions, island hydration, navigation

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-18 17:22:51 +00:00
parent 5b6e883e6d
commit 71c2003a60
33 changed files with 1848 additions and 852 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
hosts/javascript/platform.py
View File

@@ -1129,6 +1129,9 @@ PRIMITIVES_JS_MODULES: dict[str, str] = {
PRIMITIVES["context"] = sxContext;
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;
''',
}
# Modules to include by default (all)
@@ -2890,6 +2893,7 @@ PLATFORM_ORCHESTRATION_JS = """
function markProcessed(el, key) { el[PROCESSED + key] = true; }
function isProcessed(el, key) { return !!el[PROCESSED + key]; }
function clearProcessed(el, key) { delete el[PROCESSED + key]; }
// --- Script cloning ---

1
hosts/javascript/transpiler.sx
View File

@@ -420,6 +420,7 @@
"bind-preload" "bindPreload"
"mark-processed!" "markProcessed"
"is-processed?" "isProcessed"
"clear-processed!" "clearProcessed"
"create-script-clone" "createScriptClone"
"sx-render" "sxRender"
"sx-process-scripts" "sxProcessScripts"

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

@@ -118,7 +118,10 @@ let setup_io_env env =
bind "request-arg" (fun args ->
match args with
| [name] -> io_request "request-arg" [name]
| _ -> raise (Eval_error "request-arg: expected 1 arg"));
| [name; default] ->
let result = io_request "request-arg" [name] in
if result = Nil then default else result
| _ -> raise (Eval_error "request-arg: expected 1-2 args"));
bind "request-method" (fun _args ->
io_request "request-method" []);
@@ -126,7 +129,11 @@ let setup_io_env env =
bind "ctx" (fun args ->
match args with
| [key] -> io_request "ctx" [key]
| _ -> raise (Eval_error "ctx: expected 1 arg"))
| _ -> raise (Eval_error "ctx: expected 1 arg"));
(* Generic helper call — dispatches to Python page helpers *)
bind "helper" (fun args ->
io_request "helper" args)
(* ====================================================================== *)
@@ -165,6 +172,82 @@ let make_server_env () =
(* HTML renderer *)
Sx_render.setup_render_env env;
(* Render-mode flags *)
bind "set-render-active!" (fun _args -> Nil);
bind "render-active?" (fun _args -> Bool true);
(* Scope stack — platform primitives for render-time dynamic scope.
Used by aser for spread/provide/emit patterns. *)
let scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8 in
bind "scope-push!" (fun args ->
match args with
| [String name; value] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
Hashtbl.replace scope_stacks name (value :: stack); Nil
| _ -> Nil);
bind "scope-pop!" (fun args ->
match args with
| [String name] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
(match stack with
| _ :: rest -> Hashtbl.replace scope_stacks name rest
| [] -> ()); Nil
| _ -> Nil);
bind "scope-peek" (fun args ->
match args with
| [String name] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
(match stack with v :: _ -> v | [] -> Nil)
| _ -> Nil);
(* scope-emit! / scope-peek — Hashtbl-based scope primitives for aser.
Different names from emit!/emitted to avoid CEK special form conflict. *)
bind "scope-emit!" (fun args ->
match args with
| [String name; value] ->
let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in
(match stack with
| List items :: rest ->
Hashtbl.replace scope_stacks name (List (items @ [value]) :: rest)
| Nil :: rest ->
Hashtbl.replace scope_stacks name (List [value] :: rest)
| _ :: _ -> ()
| [] -> ()); Nil
| _ -> Nil);
(* Evaluator bridge — aser calls these spec functions.
Route to the OCaml CEK machine. *)
bind "eval-expr" (fun args ->
match args with
| [expr; Env e] -> Sx_ref.eval_expr expr (Env e)
| [expr] -> Sx_ref.eval_expr expr (Env env)
| _ -> raise (Eval_error "eval-expr: expected (expr env?)"));
bind "trampoline" (fun args ->
match args with
| [v] -> v (* CEK never produces thunks *)
| _ -> raise (Eval_error "trampoline: expected 1 arg"));
bind "call-lambda" (fun args ->
match args with
| [fn_val; List call_args; Env e] ->
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env e)
| [fn_val; List call_args] ->
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env env)
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
bind "expand-macro" (fun args ->
match args with
| [Macro m; List macro_args; Env e] ->
let body_env = { bindings = Hashtbl.create 16; parent = Some e } in
List.iteri (fun i p ->
let v = if i < List.length macro_args then List.nth macro_args i else Nil in
Hashtbl.replace body_env.bindings p v
) m.m_params;
Sx_ref.eval_expr m.m_body (Env body_env)
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
(* Register <> as a special form — evaluates all children, returns list *)
ignore (Sx_ref.register_special_form (String "<>") (NativeFn ("<>", fun args ->
List (List.map (fun a -> Sx_ref.eval_expr a (Env env)) args))));
(* Missing primitives that may be referenced *)
bind "upcase" (fun args ->
match args with
@@ -181,6 +264,109 @@ let make_server_env () =
| [String s] -> Keyword s
| _ -> raise (Eval_error "make-keyword: expected string"));
(* Type predicates and accessors — platform interface for aser *)
bind "lambda?" (fun args ->
match args with [Lambda _] -> Bool true | _ -> Bool false);
bind "macro?" (fun args ->
match args with [Macro _] -> Bool true | _ -> Bool false);
bind "island?" (fun args ->
match args with [Island _] -> Bool true | _ -> Bool false);
bind "component?" (fun args ->
match args with [Component _] | [Island _] -> Bool true | _ -> Bool false);
bind "callable?" (fun args ->
match args with
| [NativeFn _] | [Lambda _] | [Component _] | [Island _] -> Bool true
| _ -> Bool false);
bind "lambda-params" (fun args ->
match args with
| [Lambda l] -> List (List.map (fun s -> String s) l.l_params)
| _ -> List []);
bind "lambda-body" (fun args ->
match args with
| [Lambda l] -> l.l_body
| _ -> Nil);
bind "lambda-closure" (fun args ->
match args with
| [Lambda l] -> Env l.l_closure
| _ -> Dict (Hashtbl.create 0));
bind "component-name" (fun args ->
match args with
| [Component c] -> String c.c_name
| [Island i] -> String i.i_name
| _ -> String "");
bind "component-closure" (fun args ->
match args with
| [Component c] -> Env c.c_closure
| [Island i] -> Env i.i_closure
| _ -> Dict (Hashtbl.create 0));
bind "spread?" (fun _args -> Bool false);
bind "spread-attrs" (fun _args -> Dict (Hashtbl.create 0));
bind "is-html-tag?" (fun args ->
match args with
| [String s] -> Bool (Sx_render.is_html_tag s)
| _ -> Bool false);
(* Spec evaluator helpers needed by render.sx when loaded at runtime *)
bind "random-int" (fun args ->
match args with
| [Number lo; Number hi] ->
let lo = int_of_float lo and hi = int_of_float hi in
Number (float_of_int (lo + Random.int (max 1 (hi - lo + 1))))
| _ -> raise (Eval_error "random-int: expected (low high)"));
bind "parse-int" (fun args ->
match args with
| [String s] -> (try Number (float_of_int (int_of_string s)) with _ -> Nil)
| [Number n] -> Number (Float.round n)
| _ -> Nil);
bind "json-encode" (fun args -> io_request "helper" (String "json-encode" :: args));
bind "into" (fun args -> io_request "helper" (String "into" :: args));
bind "sleep" (fun args -> io_request "sleep" args);
bind "set-response-status" (fun args -> io_request "set-response-status" args);
bind "set-response-header" (fun args -> io_request "set-response-header" args);
(* Application constructs — no-ops in the kernel, but needed so
handler/page files load successfully (their define forms get evaluated) *)
ignore (Sx_ref.register_special_form (String "defhandler") (NativeFn ("defhandler", fun _args -> Nil)));
ignore (Sx_ref.register_special_form (String "defpage") (NativeFn ("defpage", fun _args -> Nil)));
bind "cond-scheme?" (fun args ->
match args with
| [clauses] -> Sx_ref.cond_scheme_p clauses
| _ -> Bool false);
bind "is-else-clause?" (fun args ->
match args with
| [test] -> Sx_ref.is_else_clause test
| _ -> Bool false);
bind "primitive?" (fun args ->
match args with
| [String name] ->
(* Check if name is bound in the env as a NativeFn *)
(try match env_get env name with NativeFn _ -> Bool true | _ -> Bool false
with _ -> Bool false)
| _ -> Bool false);
bind "get-primitive" (fun args ->
match args with
| [String name] ->
(try env_get env name with _ -> Nil)
| _ -> Nil);
bind "escape-string" (fun args ->
match args with
| [String s] ->
let buf = Buffer.create (String.length s) in
String.iter (fun c -> match c with
| '"' -> 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;
String (Buffer.contents buf)
| _ -> raise (Eval_error "escape-string: expected string"));
bind "string-length" (fun args ->
match args with
| [String s] -> Number (float_of_int (String.length s))
@@ -370,7 +556,56 @@ let dispatch env cmd =
let result = List.fold_left (fun _acc expr ->
Sx_ref.eval_expr expr (Env env)
) Nil exprs in
send_ok_value result
(* Use ok-raw with natural list serialization — no (list ...) wrapping.
This preserves the SX structure for Python to parse back. *)
let rec raw_serialize = function
| Nil -> "nil"
| Bool true -> "true"
| Bool false -> "false"
| Number n ->
if Float.is_integer n then string_of_int (int_of_float n)
else Printf.sprintf "%g" n
| String s -> "\"" ^ escape_sx_string s ^ "\""
| Symbol s -> s
| Keyword k -> ":" ^ k
| List items | ListRef { contents = items } ->
"(" ^ String.concat " " (List.map raw_serialize items) ^ ")"
| Dict d ->
let pairs = Hashtbl.fold (fun k v acc ->
(Printf.sprintf ":%s %s" k (raw_serialize v)) :: acc) d [] in
"{" ^ String.concat " " pairs ^ "}"
| Component c -> "~" ^ c.c_name
| Island i -> "~" ^ i.i_name
| SxExpr s -> s
| RawHTML s -> "\"" ^ escape_sx_string s ^ "\""
| _ -> "nil"
in
send (Printf.sprintf "(ok-raw %s)" (raw_serialize result))
with
| Eval_error msg -> send_error msg
| exn -> send_error (Printexc.to_string exn))
| List [Symbol "aser"; String src] ->
(* Evaluate and serialize as SX wire format.
Calls the SX-defined aser function from adapter-sx.sx.
aser is loaded into the kernel env via _ensure_components. *)
(try
let exprs = Sx_parser.parse_all src in
let expr = match exprs with
| [e] -> e
| [] -> Nil
| _ -> List (Symbol "<>" :: exprs)
in
(* Call (aser <quoted-expr> <env>) *)
let call = List [Symbol "aser";
List [Symbol "quote"; expr];
Env env] in
let result = Sx_ref.eval_expr call (Env env) in
(* Send raw SX wire format without re-escaping.
Use (ok-raw ...) so Python knows not to unescape. *)
(match result with
| String s | SxExpr s -> send (Printf.sprintf "(ok-raw %s)" s)
| _ -> send_ok_value result)
with
| Eval_error msg -> send_error msg
| exn -> send_error (Printexc.to_string exn))