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

Wire adapter-html.sx into OCaml server, replacing hand-written renderer

Browse Source 
sx_server.ml: sx_render_to_html() calls the SX adapter-html.sx render-to-html
via CEK eval, falling back to Sx_render.render_to_html if adapter not loaded.
CLI --render mode now loads render.sx + adapter-html.sx.

sx_primitives.ml: Added ~25 primitives needed by adapter-html.sx:
  scope-push!/pop!/peek/emit!, emitted, provide-push!/pop! (hashtable stack),
  lambda?/island?/component?/macro?, component-closure/name/params/body/
  has-children?, lambda-closure/params/body, is-else-clause?, for-each-indexed,
  empty-dict?, make-raw-html, raw-html-content

run_tests.ml: Loads render.sx + adapter-html.sx for test-render-html.sx.
Registers trampoline, eval-expr, scope stubs, expand-macro, cond-scheme?.

Status: 1105/1114 OCaml tests pass. 8 remaining failures are env-merge
edge cases in render-lambda-html/component-children/island rendering —
same adapter code works in JS (143/143).

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-24 01:38:18 +00:00
parent 70a58bddd8
commit 284572c7a9
4 changed files with 179 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -269,6 +269,40 @@ let make_test_env () =
(* --- HTML Renderer (from sx_render.ml library module) --- *)
Sx.Sx_render.setup_render_env env;
(* Stubs needed by adapter-html.sx when loaded at test time *)
bind "set-render-active!" (fun _args -> Nil);
bind "render-active?" (fun _args -> Bool true);
bind "trampoline" (fun args ->
match args with
| [Thunk (expr, e)] -> eval_expr expr (Env e)
| [v] -> v
| _ -> Nil);
bind "eval-expr" (fun args ->
match args with
| [expr; Env e] -> eval_expr expr (Env e)
| [expr] -> eval_expr expr (Env env)
| _ -> raise (Eval_error "eval-expr: expected (expr env)"));
bind "scope-push!" (fun args ->
ignore (Sx_runtime.scope_push (List.hd args) (if List.length args > 1 then List.nth args 1 else Nil)); Nil);
bind "scope-pop!" (fun args ->
ignore (Sx_runtime.scope_pop (List.hd args)); Nil);
bind "cond-scheme?" (fun args ->
match args with
| [(List clauses | ListRef { contents = clauses })] ->
(match clauses with
| (List _ | ListRef _) :: _ -> Bool true
| _ -> Bool false)
| _ -> Bool false);
bind "expand-macro" (fun args ->
match args with
| [Macro m; (List a | ListRef { contents = a }); _] ->
let local = Sx_types.env_extend m.m_closure in
List.iteri (fun i p ->
ignore (Sx_types.env_bind local p (if i < List.length a then List.nth a i else Nil))
) m.m_params;
eval_expr m.m_body (Env local)
| _ -> raise (Eval_error "expand-macro: expected (macro args env)"));
(* --- Missing primitives referenced by tests --- *)
bind "upcase" (fun args ->
@@ -637,16 +671,24 @@ let run_spec_tests env test_files =
Printf.printf "\nLoading test framework...\n%!";
load_and_eval framework_path;
(* Load compiler + VM spec for test-vm.sx *)
(* Load spec modules needed by tests *)
let spec_dir = Filename.concat project_dir "spec" in
List.iter (fun name ->
let path = Filename.concat spec_dir name in
let web_dir = Filename.concat project_dir "web" in
let load_spec name dir =
let path = Filename.concat dir name in
if Sys.file_exists path then begin
Printf.printf "Loading %s...\n%!" name;
(try load_and_eval path
with e -> Printf.eprintf "Warning: %s: %s\n%!" name (Printexc.to_string e))
end
) ["bytecode.sx"; "compiler.sx"; "vm.sx"];
in
(* Render adapter for test-render-html.sx *)
load_spec "render.sx" spec_dir;
load_spec "adapter-html.sx" web_dir;
(* Compiler + VM for test-vm.sx *)
load_spec "bytecode.sx" spec_dir;
load_spec "compiler.sx" spec_dir;
load_spec "vm.sx" spec_dir;
(* Determine test files *)
let files = if test_files = [] then begin