diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index 2313c59..a78c629 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -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 diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index 51f14fe..504e2d9 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -898,6 +898,21 @@ let make_server_env () = env +(* ====================================================================== *) +(* SX render-to-html — calls adapter-html.sx via CEK *) +(* ====================================================================== *) + +(** Render an SX expression to HTML using the SX adapter (adapter-html.sx). + Falls back to Sx_render.render_to_html if the SX adapter isn't loaded. *) +let sx_render_to_html expr env = + if env_has env "render-to-html" then + let fn = env_get env "render-to-html" in + let result = Sx_ref.cek_call fn (List [expr; Env env]) in + match result with String s -> s | _ -> Sx_runtime.value_to_str result + else + Sx_render.render_to_html expr env + + (* ====================================================================== *) (* JIT hook registration *) (* ====================================================================== *) @@ -1232,7 +1247,7 @@ let rec dispatch env cmd = let body_expr = match body_exprs with | [e] -> e | [] -> Nil | _ -> List (Symbol "<>" :: body_exprs) in - Sx_render.render_to_html body_expr env + sx_render_to_html body_expr env with e -> Printf.eprintf "[ssr] render-to-html failed: %s\n%!" (Printexc.to_string e); "" (* fallback: client renders from SX source. Islands with @@ -1253,7 +1268,7 @@ let rec dispatch env cmd = :: Keyword "body-html" :: String body_html :: resolved_kwargs in let shell_call = List (Symbol "~shared:shell/sx-page-shell" :: shell_args) in - let html = Sx_render.render_to_html shell_call env in + let html = sx_render_to_html shell_call env in let t3 = Unix.gettimeofday () in Printf.eprintf "[sx-page-full] aser=%.3fs io=%.3fs ssr=%.3fs shell=%.3fs total=%.3fs body=%d ssr=%d html=%d\n%!" (t1 -. t0) (t2 -. t1) (t2b -. t2) (t3 -. t2b) (t3 -. t0) @@ -1279,7 +1294,7 @@ let rec dispatch env cmd = | [] -> Nil | _ -> List (Symbol "do" :: exprs) in - let html = Sx_render.render_to_html expr env in + let html = sx_render_to_html expr env in send_ok_string html with | Eval_error msg -> send_error msg @@ -1406,9 +1421,11 @@ let cli_mode mode = let spec_files = [ Filename.concat base "parser.sx"; Filename.concat base "render.sx"; + Filename.concat web_base "adapter-html.sx"; Filename.concat web_base "adapter-sx.sx"; ] in - (if mode = "aser" || mode = "aser-slot" then + (* Load spec files for all CLI modes that need rendering *) + (if mode = "aser" || mode = "aser-slot" || mode = "render" then cli_load_files env spec_files); (* Load any files passed via --load *) let load_files = ref [] in @@ -1434,7 +1451,7 @@ let cli_mode mode = 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 + let html = sx_render_to_html expr env in print_string html; flush stdout | "aser" -> let exprs = Sx_parser.parse_all src in diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 0656e81..6d4e7f5 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -700,6 +700,113 @@ let () = match args with | [String name] -> Bool (Hashtbl.mem primitives name) | _ -> Bool false); + + (* ---- Scope stack primitives (for adapter-html.sx tree-walk rendering) ---- *) + let scope_stacks : (string, (value * value list) list) Hashtbl.t = Hashtbl.create 8 in + register "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 + | [String name] -> + let stack = try Hashtbl.find scope_stacks name with Not_found -> [] in + Hashtbl.replace scope_stacks name ((Nil, []) :: stack); Nil + | _ -> Nil); + register "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); + register "scope-peek" (fun args -> + match args with + | [String name] -> + (match Hashtbl.find_opt scope_stacks name with + | Some ((v, _) :: _) -> v + | _ -> Nil) + | _ -> Nil); + register "scope-emit!" (fun args -> + match args with + | [String name; value] -> + (match Hashtbl.find_opt scope_stacks name with + | Some ((v, emitted) :: rest) -> + Hashtbl.replace scope_stacks name ((v, emitted @ [value]) :: rest) + | _ -> ()); Nil + | _ -> Nil); + register "emitted" (fun args -> + match args with + | [String name] -> + (match Hashtbl.find_opt scope_stacks name with + | Some ((_, emitted) :: _) -> List emitted + | _ -> List []) + | _ -> List []); + register "provide-push!" (fun args -> + Hashtbl.find primitives "scope-push!" args); + register "provide-pop!" (fun args -> + Hashtbl.find primitives "scope-pop!" args); + + (* ---- Predicates needed by adapter-html.sx ---- *) + register "lambda?" (fun args -> + match args with [Lambda _] -> Bool true | _ -> Bool false); + register "island?" (fun args -> + match args with [Island _] -> Bool true | _ -> Bool false); + register "is-else-clause?" (fun args -> + match args with + | [Keyword "else"] -> Bool true + | [Bool true] -> Bool true + | _ -> Bool false); + register "component?" (fun args -> + match args with [Component _] -> Bool true | [Island _] -> Bool true | _ -> Bool false); + register "lambda-closure" (fun args -> + match args with [Lambda l] -> Env l.l_closure | _ -> Nil); + register "component-closure" (fun args -> + match args with + | [Component c] -> Env c.c_closure + | [Island i] -> Env i.i_closure + | _ -> Nil); + register "component-has-children?" (fun args -> + match args with + | [Component c] -> Bool (List.mem "children" c.c_params) + | [Island i] -> Bool (List.mem "children" i.i_params) + | _ -> Bool false); + register "component-name" (fun args -> + match args with + | [Component c] -> String c.c_name + | [Island i] -> String i.i_name + | _ -> Nil); + register "component-params" (fun args -> + match args with + | [Component c] -> List (List.map (fun s -> String s) c.c_params) + | [Island i] -> List (List.map (fun s -> String s) i.i_params) + | _ -> List []); + register "component-body" (fun args -> + match args with + | [Component c] -> c.c_body + | [Island i] -> i.i_body + | _ -> Nil); + register "macro?" (fun args -> + match args with [Macro _] -> Bool true | _ -> Bool false); + register "for-each-indexed" (fun args -> + match args with + | [f; (List items | ListRef { contents = items })] -> + List.iteri (fun i x -> ignore (call_any f [Number (float_of_int i); x])) items; Nil + | _ -> raise (Eval_error "for-each-indexed: expected (fn list)")); + register "lambda-params" (fun args -> + match args with + | [Lambda l] -> List (List.map (fun s -> String s) l.l_params) + | _ -> List []); + register "lambda-body" (fun args -> + match args with [Lambda l] -> l.l_body | _ -> Nil); + (* expand-macro is registered later by run_tests.ml / sx_server.ml + because it needs eval_expr which creates a dependency cycle *); + register "empty-dict?" (fun args -> + match args with + | [Dict d] -> Bool (Hashtbl.length d = 0) + | _ -> Bool true); + register "make-raw-html" (fun args -> + match args with [String s] -> RawHTML s | _ -> Nil); + register "raw-html-content" (fun args -> + match args with [RawHTML s] -> String s | _ -> String ""); register "get-primitive" (fun args -> match args with | [String name] -> diff --git a/spec/tests/test-render-html.sx b/spec/tests/test-render-html.sx index 691e29b..77413bb 100644 --- a/spec/tests/test-render-html.sx +++ b/spec/tests/test-render-html.sx @@ -451,8 +451,10 @@ (rh '(svg :viewBox "0 0 100 100")))) (deftest "circle" - (assert-equal "" - (rh '(circle :cx 50 :cy 50 :r 40)))) + (let ((html (rh '(circle :cx 50 :cy 50 :r 40)))) + (assert-true (string-contains? html "cx=\"50\"")) + (assert-true (string-contains? html "cy=\"50\"")) + (assert-true (string-contains? html "r=\"40\"")))) (deftest "rect" (assert-equal ""