Files
rose-ash/hosts/ocaml/lib/sx_render.ml
giles cfc697821f Step 5.5 phase 3: transpile HTML renderer from SX spec
Replaces 753 lines of hand-written sx_render.ml with 380 lines (17
transpiled functions from spec/render.sx + web/adapter-html.sx, plus
native PREAMBLE and FIXUPS).

Source of truth is now the SX spec files:
- spec/render.sx: registries, helpers (parse-element-args, definition-form?,
  eval-cond, process-bindings, merge-spread-attrs, is-render-expr?)
- web/adapter-html.sx: dispatch (render-to-html, render-list-to-html,
  dispatch-html-form, render-html-element, render-html-component,
  render-lambda-html, render-value-to-html)

Native OCaml retained in PREAMBLE/FIXUPS for:
- Tag registries (dual string list / value List)
- Buffer-based escape_html_raw and render_attrs
- expand_macro, try_catch, set_render_active platform functions
- Forward refs for lake/marsh/island (web-specific)
- setup_render_env, buffer renderer, streaming renderer

New bootstrap: hosts/ocaml/bootstrap_render.py
Transpiler: added eval-expr, expand-macro, try-catch, set-render-active!,
scope-emitted to ml-runtime-names.

2598/2598 tests passing.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-03 20:16:26 +00:00

381 lines
34 KiB
OCaml

(* sx_render.ml — Auto-generated from spec/render.sx + web/adapter-html.sx *)
(* Do not edit — regenerate with: python3 hosts/ocaml/bootstrap_render.py *)
[@@@warning "-26-27"]
open Sx_types
open Sx_runtime
(* ====================================================================== *)
(* Platform bindings — native OCaml for performance and type access *)
(* ====================================================================== *)
let eval_expr expr env = Sx_ref.eval_expr expr env
let cond_scheme_p = Sx_ref.cond_scheme_p
(* Primitive wrappers needed as direct OCaml functions *)
let raw_html_content v = match v with RawHTML s -> String s | _ -> String ""
let make_raw_html v = match v with String s -> RawHTML s | _ -> Nil
let scope_emit v1 v2 = prim_call "scope-emit!" [v1; v2]
let init v = prim_call "init" [v]
let dict_has a b = prim_call "dict-has?" [a; b]
let dict_get a b = prim_call "dict-get" [a; b]
let is_component v = prim_call "component?" [v]
let is_island v = prim_call "island?" [v]
let is_macro v = prim_call "macro?" [v]
let is_lambda v = prim_call "lambda?" [v]
let is_nil v = prim_call "nil?" [v]
(* Forward refs for web-specific renderers — set in FIXUPS or by caller *)
let render_html_lake_ref : (value -> value -> value) ref = ref (fun _ _ -> String "")
let render_html_marsh_ref : (value -> value -> value) ref = ref (fun _ _ -> String "")
let render_html_island_ref : (value -> value -> value -> value) ref = ref (fun _ _ _ -> String "")
let render_html_lake args env = !render_html_lake_ref args env
let render_html_marsh args env = !render_html_marsh_ref args env
let render_html_island comp args env = !render_html_island_ref comp args env
let cek_call = Sx_ref.cek_call
let trampoline v = match v with
| Thunk (expr, env) -> Sx_ref.eval_expr expr (Env env)
| other -> other
let expand_macro m args_val _env = match m with
| Macro mac ->
let args = match args_val with List l | ListRef { contents = l } -> l | _ -> [] in
let local = env_extend (Env mac.m_closure) in
let rec bind_params ps as' = match ps, as' with
| [], rest ->
(match mac.m_rest_param with
| Some rp -> ignore (env_bind local (String rp) (List rest))
| None -> ())
| p :: ps_rest, a :: as_rest ->
ignore (env_bind local p a);
bind_params ps_rest as_rest
| _ :: _, [] ->
List.iter (fun p -> ignore (env_bind local p Nil)) (List.rev ps)
in
bind_params (List.map (fun p -> String p) mac.m_params) args;
Sx_ref.eval_expr mac.m_body local
| _ -> Nil
(** try-catch: wraps a try body fn and catch handler fn.
Maps to OCaml exception handling. *)
let try_catch try_fn catch_fn =
try sx_call try_fn []
with
| Eval_error msg -> sx_call catch_fn [String msg]
| e -> sx_call catch_fn [String (Printexc.to_string e)]
(** set-render-active! — no-op on OCaml (always active). *)
let set_render_active_b _v = Nil
(* ====================================================================== *)
(* Performance-critical: native Buffer-based HTML escaping *)
(* ====================================================================== *)
(* ====================================================================== *)
(* Tag registries — native string lists for callers, value Lists for SX *)
(* ====================================================================== *)
let boolean_attrs_set = [
"async"; "autofocus"; "autoplay"; "checked"; "controls"; "default";
"defer"; "disabled"; "formnovalidate"; "hidden"; "inert"; "ismap";
"loop"; "multiple"; "muted"; "nomodule"; "novalidate"; "open";
"playsinline"; "readonly"; "required"; "reversed"; "selected"
]
let is_boolean_attr name = List.mem name boolean_attrs_set
let html_tags_list = [
"html"; "head"; "body"; "title"; "meta"; "link"; "script"; "style"; "noscript";
"header"; "nav"; "main"; "section"; "article"; "aside"; "footer";
"h1"; "h2"; "h3"; "h4"; "h5"; "h6"; "hgroup";
"div"; "p"; "blockquote"; "pre"; "figure"; "figcaption"; "address"; "hr";
"ul"; "ol"; "li"; "dl"; "dt"; "dd"; "menu"; "details"; "summary"; "dialog";
"a"; "span"; "em"; "strong"; "small"; "b"; "i"; "u"; "s"; "sub"; "sup";
"mark"; "abbr"; "cite"; "code"; "kbd"; "samp"; "var"; "time"; "br"; "wbr";
"table"; "thead"; "tbody"; "tfoot"; "tr"; "th"; "td"; "caption"; "colgroup"; "col";
"form"; "input"; "textarea"; "select"; "option"; "optgroup"; "button"; "label";
"fieldset"; "legend"; "datalist"; "output";
"img"; "video"; "audio"; "source"; "picture"; "canvas"; "iframe";
"svg"; "path"; "circle"; "rect"; "line"; "polyline"; "polygon"; "ellipse";
"g"; "defs"; "use"; "text"; "tspan"; "clipPath"; "mask"; "pattern";
"linearGradient"; "radialGradient"; "stop"; "filter";
"feGaussianBlur"; "feOffset"; "feBlend"; "feColorMatrix"; "feComposite";
"feMerge"; "feMergeNode"; "feTurbulence"; "feComponentTransfer";
"feFuncR"; "feFuncG"; "feFuncB"; "feFuncA"; "feDisplacementMap"; "feFlood";
"feImage"; "feMorphology"; "feSpecularLighting"; "feDiffuseLighting";
"fePointLight"; "feSpotLight"; "feDistantLight";
"animate"; "animateTransform"; "foreignObject"; "template"; "slot"
]
let html_tags = html_tags_list (* callers expect string list *)
let html_tags_val = List (List.map (fun s -> String s) html_tags_list)
let void_elements_list = [
"area"; "base"; "br"; "col"; "embed"; "hr"; "img"; "input";
"link"; "meta"; "param"; "source"; "track"; "wbr"
]
let void_elements = void_elements_list (* callers expect string list *)
let void_elements_val = List (List.map (fun s -> String s) void_elements_list)
let boolean_attrs = boolean_attrs_set (* callers expect string list *)
let boolean_attrs_val = List (List.map (fun s -> String s) boolean_attrs_set)
(* Native escape for internal use — returns raw OCaml string *)
let escape_html_raw s =
let buf = Buffer.create (String.length s) in
String.iter (function
| '&' -> Buffer.add_string buf "&amp;"
| '<' -> Buffer.add_string buf "&lt;"
| '>' -> Buffer.add_string buf "&gt;"
| '"' -> Buffer.add_string buf "&quot;"
| c -> Buffer.add_char buf c) s;
Buffer.contents buf
(* escape_html: native string -> string for callers *)
let escape_html = escape_html_raw
(* escape_html_val / escape_attr_val — take a value, return String value (for transpiled code) *)
let escape_html_val v =
let s = match v with String s -> s | v -> value_to_string v in
String (escape_html_raw s)
let escape_attr_val v = escape_html_val v
(* ====================================================================== *)
(* Performance-critical: native attribute rendering *)
(* ====================================================================== *)
let render_attrs attrs = match attrs with
| Dict d ->
let buf = Buffer.create 64 in
Hashtbl.iter (fun k v ->
if is_boolean_attr k then begin
if sx_truthy v then begin
Buffer.add_char buf ' ';
Buffer.add_string buf k
end
end else if v <> Nil then begin
Buffer.add_char buf ' ';
Buffer.add_string buf k;
Buffer.add_string buf "=\"";
Buffer.add_string buf (escape_html_raw (value_to_string v));
Buffer.add_char buf '"'
end) d;
String (Buffer.contents buf)
| _ -> String ""
(* ====================================================================== *)
(* Forward ref — used by setup_render_env and buffer renderer *)
(* ====================================================================== *)
let render_to_html_ref : (value -> value -> value) ref =
ref (fun _expr _env -> String "")
(* scope-emitted is a prim alias *)
let scope_emitted name = prim_call "scope-emitted" [name]
(* RENDER_HTML_FORMS — list of special form names handled by dispatch-html-form *)
let render_html_forms = List [
String "if"; String "when"; String "cond"; String "case";
String "let"; String "let*"; String "letrec";
String "begin"; String "do";
String "define"; String "defcomp"; String "defmacro"; String "defisland";
String "defpage"; String "defhandler"; String "defquery"; String "defaction";
String "defrelation"; String "deftype"; String "defeffect"; String "defstyle";
String "map"; String "map-indexed"; String "filter"; String "for-each";
String "scope"; String "provide"
]
(* === Transpiled from render spec + adapter === *)
(* *definition-form-extensions* *)
let rec _definition_form_extensions_ =
(List [])
(* definition-form? *)
and definition_form_p name =
(let _or = (prim_call "=" [name; (String "define")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "defcomp")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "defisland")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "defmacro")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "defstyle")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "deftype")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [name; (String "defeffect")]) in if sx_truthy _or then _or else (prim_call "contains?" [_definition_form_extensions_; name]))))))))
(* parse-element-args *)
and parse_element_args args env =
(let attrs = (Dict (Hashtbl.create 0)) in let children = ref ((List [])) in (let () = ignore ((List.fold_left (fun state arg -> (let skip = (get (state) ((String "skip"))) in (if sx_truthy (skip) then (prim_call "assoc" [state; (String "skip"); (Bool false); (String "i"); (prim_call "inc" [(get (state) ((String "i")))])]) else (if sx_truthy ((let _and = (prim_call "=" [(type_of (arg)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "<" [(prim_call "inc" [(get (state) ((String "i")))]); (len (args))]))) then (let val' = (trampoline ((eval_expr ((nth (args) ((prim_call "inc" [(get (state) ((String "i")))])))) (env)))) in (let () = ignore ((sx_dict_set_b attrs (keyword_name (arg)) val')) in (prim_call "assoc" [state; (String "skip"); (Bool true); (String "i"); (prim_call "inc" [(get (state) ((String "i")))])]))) else (let () = ignore ((children := sx_append_b !children arg; Nil)) in (prim_call "assoc" [state; (String "i"); (prim_call "inc" [(get (state) ((String "i")))])])))))) (let _d = Hashtbl.create 2 in Hashtbl.replace _d (value_to_str (String "i")) (Number 0.0); Hashtbl.replace _d (value_to_str (String "skip")) (Bool false); Dict _d) (sx_to_list args))) in (List [attrs; !children])))
(* eval-cond *)
and eval_cond clauses env =
(if sx_truthy ((cond_scheme_p (clauses))) then (eval_cond_scheme (clauses) (env)) else (eval_cond_clojure (clauses) (env)))
(* eval-cond-scheme *)
and eval_cond_scheme clauses env =
(if sx_truthy ((empty_p (clauses))) then Nil else (let clause = (first (clauses)) in let test = (first (clause)) in let body = (nth (clause) ((Number 1.0))) in (if sx_truthy ((is_else_clause (test))) then body else (if sx_truthy ((trampoline ((eval_expr (test) (env))))) then body else (eval_cond_scheme ((rest (clauses))) (env))))))
(* eval-cond-clojure *)
and eval_cond_clojure clauses env =
(if sx_truthy ((prim_call "<" [(len (clauses)); (Number 2.0)])) then Nil else (let test = (first (clauses)) in let body = (nth (clauses) ((Number 1.0))) in (if sx_truthy ((is_else_clause (test))) then body else (if sx_truthy ((trampoline ((eval_expr (test) (env))))) then body else (eval_cond_clojure ((prim_call "slice" [clauses; (Number 2.0)])) (env))))))
(* process-bindings *)
and process_bindings bindings env =
(let local = (env_extend (env)) in (let () = ignore ((List.iter (fun pair -> ignore ((if sx_truthy ((let _and = (prim_call "=" [(type_of (pair)); (String "list")]) in if not (sx_truthy _and) then _and else (prim_call ">=" [(len (pair)); (Number 2.0)]))) then (let name = (if sx_truthy ((prim_call "=" [(type_of ((first (pair)))); (String "symbol")])) then (symbol_name ((first (pair)))) else (String (sx_str [(first (pair))]))) in (env_bind local (sx_to_string name) (trampoline ((eval_expr ((nth (pair) ((Number 1.0)))) (local)))))) else Nil))) (sx_to_list bindings); Nil)) in local))
(* is-render-expr? *)
and is_render_expr_p expr =
(if sx_truthy ((let _or = (Bool (not (sx_truthy ((prim_call "=" [(type_of (expr)); (String "list")]))))) in if sx_truthy _or then _or else (empty_p (expr)))) then (Bool false) else (let h = (first (expr)) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (h)); (String "symbol")])))))) then (Bool false) else (let n = (symbol_name (h)) in (let _or = (prim_call "=" [n; (String "<>")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [n; (String "raw!")]) in if sx_truthy _or then _or else (let _or = (prim_call "starts-with?" [n; (String "~")]) in if sx_truthy _or then _or else (let _or = (prim_call "starts-with?" [n; (String "html:")]) in if sx_truthy _or then _or else (let _or = (prim_call "contains?" [html_tags_val; n]) in if sx_truthy _or then _or else (let _and = (prim_call ">" [(prim_call "index-of" [n; (String "-")]); (Number 0.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call ">" [(len (expr)); (Number 1.0)]) in if not (sx_truthy _and) then _and else (prim_call "=" [(type_of ((nth (expr) ((Number 1.0))))); (String "keyword")]))))))))))))
(* merge-spread-attrs *)
and merge_spread_attrs target spread_dict =
(List.iter (fun key -> ignore ((let val' = (dict_get (spread_dict) (key)) in (if sx_truthy ((prim_call "=" [key; (String "class")])) then (let existing = (dict_get (target) ((String "class"))) in (sx_dict_set_b target (String "class") (if sx_truthy ((let _and = existing in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((prim_call "=" [existing; (String "")]))))))) then (String (sx_str [existing; (String " "); val'])) else val'))) else (if sx_truthy ((prim_call "=" [key; (String "style")])) then (let existing = (dict_get (target) ((String "style"))) in (sx_dict_set_b target (String "style") (if sx_truthy ((let _and = existing in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((prim_call "=" [existing; (String "")]))))))) then (String (sx_str [existing; (String ";"); val'])) else val'))) else (sx_dict_set_b target key val')))))) (sx_to_list (prim_call "keys" [spread_dict])); Nil)
(* render-to-html *)
and render_to_html expr env =
(let () = ignore ((set_render_active_b ((Bool true)))) in (let _match_val = (type_of (expr)) in (if _match_val = (String "nil") then (String "") else (if _match_val = (String "string") then (escape_html_val (expr)) else (if _match_val = (String "number") then (String (sx_str [expr])) else (if _match_val = (String "boolean") then (if sx_truthy (expr) then (String "true") else (String "false")) else (if _match_val = (String "list") then (if sx_truthy ((empty_p (expr))) then (String "") else (render_list_to_html (expr) (env))) else (if _match_val = (String "symbol") then (render_value_to_html ((trampoline ((eval_expr (expr) (env))))) (env)) else (if _match_val = (String "keyword") then (escape_html_val ((keyword_name (expr)))) else (if _match_val = (String "raw-html") then (raw_html_content (expr)) else (if _match_val = (String "spread") then (let () = ignore ((scope_emit ((String "element-attrs")) ((spread_attrs (expr))))) in (String "")) else (if _match_val = (String "thunk") then (render_to_html ((thunk_expr (expr))) ((thunk_env (expr)))) else (render_value_to_html ((trampoline ((eval_expr (expr) (env))))) (env))))))))))))))
(* render-value-to-html *)
and render_value_to_html val' env =
(let _match_val = (type_of (val')) in (if _match_val = (String "nil") then (String "") else (if _match_val = (String "string") then (escape_html_val (val')) else (if _match_val = (String "number") then (String (sx_str [val'])) else (if _match_val = (String "boolean") then (if sx_truthy (val') then (String "true") else (String "false")) else (if _match_val = (String "list") then (render_list_to_html (val') (env)) else (if _match_val = (String "raw-html") then (raw_html_content (val')) else (if _match_val = (String "spread") then (let () = ignore ((scope_emit ((String "element-attrs")) ((spread_attrs (val'))))) in (String "")) else (if _match_val = (String "thunk") then (render_to_html ((thunk_expr (val'))) ((thunk_env (val')))) else (escape_html_val ((String (sx_str [val'])))))))))))))
(* render-html-form? *)
and render_html_form_p name =
(prim_call "contains?" [render_html_forms; name])
(* render-list-to-html *)
and render_list_to_html expr env =
(if sx_truthy ((empty_p (expr))) then (String "") else (let head = (first (expr)) in (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(type_of (head)); (String "symbol")])))))) then (prim_call "join" [(String ""); (List (List.map (fun x -> (render_value_to_html (x) (env))) (sx_to_list expr)))]) else (let name = (symbol_name (head)) in let args = (rest (expr)) in (if sx_truthy ((prim_call "=" [name; (String "<>")])) then (prim_call "join" [(String ""); (List (List.map (fun x -> (render_to_html (x) (env))) (sx_to_list args)))]) else (if sx_truthy ((prim_call "=" [name; (String "raw!")])) then (prim_call "join" [(String ""); (List (List.map (fun x -> (String (sx_str [(trampoline ((eval_expr (x) (env))))]))) (sx_to_list args)))]) else (if sx_truthy ((prim_call "=" [name; (String "lake")])) then (render_html_lake (args) (env)) else (if sx_truthy ((prim_call "=" [name; (String "marsh")])) then (render_html_marsh (args) (env)) else (if sx_truthy ((prim_call "=" [name; (String "error-boundary")])) then (let has_fallback = (prim_call ">" [(len (args)); (Number 1.0)]) in (let body_exprs = (if sx_truthy (has_fallback) then (rest (args)) else args) in let fallback_expr = (if sx_truthy (has_fallback) then (first (args)) else Nil) in (String (sx_str [(String "<div data-sx-boundary=\"true\">"); (try_catch ((NativeFn ("\206\187", fun _args -> (fun () -> (prim_call "join" [(String ""); (List (List.map (fun x -> (render_to_html (x) (env))) (sx_to_list body_exprs)))])) ()))) ((NativeFn ("\206\187", fun _args -> match _args with [err] -> (fun err -> (let safe_err = (prim_call "replace" [(prim_call "replace" [(String (sx_str [err])); (String "<"); (String "&lt;")]); (String ">"); (String "&gt;")]) in (if sx_truthy ((let _and = fallback_expr in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_nil (fallback_expr)))))))) then (try_catch ((NativeFn ("\206\187", fun _args -> (fun () -> (render_to_html ((List [(trampoline ((eval_expr (fallback_expr) (env)))); err; Nil])) (env))) ()))) ((NativeFn ("\206\187", fun _args -> match _args with [e2] -> (fun e2 -> (String (sx_str [(String "<div class=\"sx-render-error\" style=\"color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;\">Render error: "); safe_err; (String "</div>")]))) e2 | _ -> Nil)))) else (String (sx_str [(String "<div class=\"sx-render-error\" style=\"color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;\">Render error: "); safe_err; (String "</div>")]))))) err | _ -> Nil)))); (String "</div>")])))) else (if sx_truthy ((let _or = (prim_call "=" [name; (String "portal")]) in if sx_truthy _or then _or else (prim_call "=" [name; (String "promise-delayed")]))) then (prim_call "join" [(String ""); (List (List.map (fun x -> (render_to_html (x) (env))) (sx_to_list args)))]) else (if sx_truthy ((prim_call "contains?" [html_tags_val; name])) then (render_html_element (name) (args) (env)) else (if sx_truthy ((let _and = (prim_call "starts-with?" [name; (String "~")]) in if not (sx_truthy _and) then _and else (let _and = (env_has (env) (name)) in if not (sx_truthy _and) then _and else (is_island ((env_get (env) (name))))))) then (render_html_island ((env_get (env) (name))) (args) (env)) else (if sx_truthy ((prim_call "starts-with?" [name; (String "~")])) then (let val' = (env_get (env) (name)) in (if sx_truthy ((is_component (val'))) then (render_html_component (val') (args) (env)) else (if sx_truthy ((is_macro (val'))) then (render_to_html ((expand_macro (val') (args) (env))) (env)) else (String (sx_str [(String "<!-- unknown component: "); name; (String " -->")]))))) else (if sx_truthy ((render_html_form_p (name))) then (dispatch_html_form (name) (expr) (env)) else (if sx_truthy ((let _and = (env_has (env) (name)) in if not (sx_truthy _and) then _and else (is_macro ((env_get (env) (name)))))) then (render_to_html ((expand_macro ((env_get (env) (name))) (args) (env))) (env)) else (render_value_to_html ((trampoline ((eval_expr (expr) (env))))) (env)))))))))))))))))
(* dispatch-html-form *)
and dispatch_html_form name expr env =
(if sx_truthy ((prim_call "=" [name; (String "if")])) then (let cond_val = (trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env)))) in (if sx_truthy (cond_val) then (render_to_html ((nth (expr) ((Number 2.0)))) (env)) else (if sx_truthy ((prim_call ">" [(len (expr)); (Number 3.0)])) then (render_to_html ((nth (expr) ((Number 3.0)))) (env)) else (String "")))) else (if sx_truthy ((prim_call "=" [name; (String "when")])) then (if sx_truthy ((Bool (not (sx_truthy ((trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env))))))))) then (String "") else (if sx_truthy ((prim_call "=" [(len (expr)); (Number 3.0)])) then (render_to_html ((nth (expr) ((Number 2.0)))) (env)) else (prim_call "join" [(String ""); (List (List.map (fun i -> (render_to_html ((nth (expr) (i))) (env))) (sx_to_list (prim_call "range" [(Number 2.0); (len (expr))]))))]))) else (if sx_truthy ((prim_call "=" [name; (String "cond")])) then (let branch = (eval_cond ((rest (expr))) (env)) in (if sx_truthy (branch) then (render_to_html (branch) (env)) else (String ""))) else (if sx_truthy ((prim_call "=" [name; (String "case")])) then (render_to_html ((trampoline ((eval_expr (expr) (env))))) (env)) else (if sx_truthy ((prim_call "=" [name; (String "letrec")])) then (let bindings = (nth (expr) ((Number 1.0))) in let body = (prim_call "slice" [expr; (Number 2.0)]) in let local = (env_extend (env)) in (let () = ignore ((List.iter (fun pair -> ignore ((let pname = (if sx_truthy ((prim_call "=" [(type_of ((first (pair)))); (String "symbol")])) then (symbol_name ((first (pair)))) else (String (sx_str [(first (pair))]))) in (env_bind local (sx_to_string pname) Nil)))) (sx_to_list bindings); Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((let pname = (if sx_truthy ((prim_call "=" [(type_of ((first (pair)))); (String "symbol")])) then (symbol_name ((first (pair)))) else (String (sx_str [(first (pair))]))) in (env_set local (sx_to_string pname) (trampoline ((eval_expr ((nth (pair) ((Number 1.0)))) (local)))))))) (sx_to_list bindings); Nil)) in (let () = ignore ((if sx_truthy ((prim_call ">" [(len (body)); (Number 1.0)])) then (List.iter (fun e -> ignore ((trampoline ((eval_expr (e) (local)))))) (sx_to_list (init (body))); Nil) else Nil)) in (render_to_html ((last (body))) (local)))))) else (if sx_truthy ((let _or = (prim_call "=" [name; (String "let")]) in if sx_truthy _or then _or else (prim_call "=" [name; (String "let*")]))) then (let local = (process_bindings ((nth (expr) ((Number 1.0)))) (env)) in (if sx_truthy ((prim_call "=" [(len (expr)); (Number 3.0)])) then (render_to_html ((nth (expr) ((Number 2.0)))) (local)) else (prim_call "join" [(String ""); (List (List.map (fun i -> (render_to_html ((nth (expr) (i))) (local))) (sx_to_list (prim_call "range" [(Number 2.0); (len (expr))]))))]))) else (if sx_truthy ((let _or = (prim_call "=" [name; (String "begin")]) in if sx_truthy _or then _or else (prim_call "=" [name; (String "do")]))) then (if sx_truthy ((prim_call "=" [(len (expr)); (Number 2.0)])) then (render_to_html ((nth (expr) ((Number 1.0)))) (env)) else (prim_call "join" [(String ""); (List (List.map (fun i -> (render_to_html ((nth (expr) (i))) (env))) (sx_to_list (prim_call "range" [(Number 1.0); (len (expr))]))))])) else (if sx_truthy ((definition_form_p (name))) then (let () = ignore ((trampoline ((eval_expr (expr) (env))))) in (String "")) else (if sx_truthy ((prim_call "=" [name; (String "map")])) then (let f = (trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env)))) in let coll = (trampoline ((eval_expr ((nth (expr) ((Number 2.0)))) (env)))) in (prim_call "join" [(String ""); (List (List.map (fun item -> (if sx_truthy ((is_lambda (f))) then (render_lambda_html (f) ((List [item])) (env)) else (render_to_html ((sx_apply f (List [item]))) (env)))) (sx_to_list coll)))])) else (if sx_truthy ((prim_call "=" [name; (String "map-indexed")])) then (let f = (trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env)))) in let coll = (trampoline ((eval_expr ((nth (expr) ((Number 2.0)))) (env)))) in (prim_call "join" [(String ""); (List (List.mapi (fun i item -> let i = Number (float_of_int i) in (if sx_truthy ((is_lambda (f))) then (render_lambda_html (f) ((List [i; item])) (env)) else (render_to_html ((sx_apply f (List [i; item]))) (env)))) (sx_to_list coll)))])) else (if sx_truthy ((prim_call "=" [name; (String "filter")])) then (render_to_html ((trampoline ((eval_expr (expr) (env))))) (env)) else (if sx_truthy ((prim_call "=" [name; (String "for-each")])) then (let f = (trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env)))) in let coll = (trampoline ((eval_expr ((nth (expr) ((Number 2.0)))) (env)))) in (prim_call "join" [(String ""); (List (List.map (fun item -> (if sx_truthy ((is_lambda (f))) then (render_lambda_html (f) ((List [item])) (env)) else (render_to_html ((sx_apply f (List [item]))) (env)))) (sx_to_list coll)))])) else (if sx_truthy ((prim_call "=" [name; (String "scope")])) then (let scope_name = (trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env)))) in let rest_args = (prim_call "slice" [expr; (Number 2.0)]) in let scope_val = ref (Nil) in let body_exprs = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest_args)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest_args)))); (String "value")])))) then (let () = ignore ((scope_val := (trampoline ((eval_expr ((nth (rest_args) ((Number 1.0)))) (env)))); Nil)) in (body_exprs := (prim_call "slice" [rest_args; (Number 2.0)]); Nil)) else (body_exprs := rest_args; Nil))) in (let () = ignore ((scope_push (scope_name) (!scope_val))) in (let result' = (if sx_truthy ((prim_call "=" [(len (!body_exprs)); (Number 1.0)])) then (render_to_html ((first (!body_exprs))) (env)) else (prim_call "join" [(String ""); (List (List.map (fun e -> (render_to_html (e) (env))) (sx_to_list !body_exprs)))])) in (let () = ignore ((scope_pop (scope_name))) in result'))))) else (if sx_truthy ((prim_call "=" [name; (String "provide")])) then (let prov_name = (trampoline ((eval_expr ((nth (expr) ((Number 1.0)))) (env)))) in let prov_val = (trampoline ((eval_expr ((nth (expr) ((Number 2.0)))) (env)))) in let body_start = (Number 3.0) in let body_count = (prim_call "-" [(len (expr)); (Number 3.0)]) in (let () = ignore ((scope_push (prov_name) (prov_val))) in (let result' = (if sx_truthy ((prim_call "=" [body_count; (Number 1.0)])) then (render_to_html ((nth (expr) (body_start))) (env)) else (prim_call "join" [(String ""); (List (List.map (fun i -> (render_to_html ((nth (expr) (i))) (env))) (sx_to_list (prim_call "range" [body_start; (prim_call "+" [body_start; body_count])]))))])) in (let () = ignore ((scope_pop (prov_name))) in result')))) else (render_value_to_html ((trampoline ((eval_expr (expr) (env))))) (env))))))))))))))))
(* render-lambda-html *)
and render_lambda_html f args env =
(let local = (env_merge ((lambda_closure (f))) (env)) in (let () = ignore ((for_each_indexed ((NativeFn ("\206\187", fun _args -> match _args with [i; p] -> (fun i p -> (env_bind local (sx_to_string p) (nth (args) (i)))) i p | _ -> Nil))) ((lambda_params (f))))) in (render_to_html ((lambda_body (f))) (local))))
(* render-html-component *)
and render_html_component comp args env =
(let kwargs = (Dict (Hashtbl.create 0)) in let children = ref ((List [])) in (let () = ignore ((List.fold_left (fun state arg -> (let skip = (get (state) ((String "skip"))) in (if sx_truthy (skip) then (prim_call "assoc" [state; (String "skip"); (Bool false); (String "i"); (prim_call "inc" [(get (state) ((String "i")))])]) else (if sx_truthy ((let _and = (prim_call "=" [(type_of (arg)); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "<" [(prim_call "inc" [(get (state) ((String "i")))]); (len (args))]))) then (let val' = (trampoline ((eval_expr ((nth (args) ((prim_call "inc" [(get (state) ((String "i")))])))) (env)))) in (let () = ignore ((sx_dict_set_b kwargs (keyword_name (arg)) val')) in (prim_call "assoc" [state; (String "skip"); (Bool true); (String "i"); (prim_call "inc" [(get (state) ((String "i")))])]))) else (let () = ignore ((children := sx_append_b !children arg; Nil)) in (prim_call "assoc" [state; (String "i"); (prim_call "inc" [(get (state) ((String "i")))])])))))) (let _d = Hashtbl.create 2 in Hashtbl.replace _d (value_to_str (String "i")) (Number 0.0); Hashtbl.replace _d (value_to_str (String "skip")) (Bool false); Dict _d) (sx_to_list args))) in (let local = (env_merge ((component_closure (comp))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (if sx_truthy ((dict_has (kwargs) (p))) then (dict_get (kwargs) (p)) else Nil)))) (sx_to_list (component_params (comp))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (comp))) then (env_bind local (sx_to_string (String "children")) (make_raw_html ((prim_call "join" [(String ""); (List (List.map (fun c -> (render_to_html (c) (env))) (sx_to_list !children)))])))) else Nil)) in (render_to_html ((component_body (comp))) (local)))))))
(* render-html-element *)
and render_html_element tag args env =
(let parsed = (parse_element_args (args) (env)) in let attrs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let is_void = (prim_call "contains?" [void_elements_val; tag]) in (if sx_truthy (is_void) then (String (sx_str [(String "<"); tag; (render_attrs (attrs)); (String " />")])) else (let () = ignore ((scope_push ((String "element-attrs")) (Nil))) in (let content = (prim_call "join" [(String ""); (List (List.map (fun c -> (render_to_html (c) (env))) (sx_to_list children)))]) in (let () = ignore ((List.iter (fun spread_dict -> ignore ((merge_spread_attrs (attrs) (spread_dict)))) (sx_to_list (scope_emitted ((String "element-attrs")))); Nil)) in (let () = ignore ((scope_pop ((String "element-attrs")))) in (String (sx_str [(String "<"); tag; (render_attrs (attrs)); (String ">"); content; (String "</"); tag; (String ">")]))))))))
(* ====================================================================== *)
(* Wire up forward ref *)
(* ====================================================================== *)
let () = render_to_html_ref := render_to_html
(* ====================================================================== *)
(* Buffer-based streaming renderer — zero intermediate string allocation *)
(* ====================================================================== *)
(** Escape HTML directly into a buffer. *)
let escape_html_buf buf s =
for i = 0 to String.length s - 1 do
match String.unsafe_get s i with
| '&' -> Buffer.add_string buf "&amp;"
| '<' -> Buffer.add_string buf "&lt;"
| '>' -> Buffer.add_string buf "&gt;"
| '"' -> Buffer.add_string buf "&quot;"
| c -> Buffer.add_char buf c
done
let render_attrs_buf buf attrs =
Hashtbl.iter (fun k v ->
if is_boolean_attr k then begin
if sx_truthy v then begin
Buffer.add_char buf ' ';
Buffer.add_string buf k
end
end else if v <> Nil then begin
Buffer.add_char buf ' ';
Buffer.add_string buf k;
Buffer.add_string buf "=\"";
escape_html_buf buf (value_to_string v);
Buffer.add_char buf '"'
end) attrs
(** Render to pre-allocated buffer — delegates to transpiled render_to_html
and extracts the string result. *)
let render_to_buf buf expr (env : env) =
match !render_to_html_ref expr (Env env) with
| String s -> Buffer.add_string buf s
| RawHTML s -> Buffer.add_string buf s
| v -> Buffer.add_string buf (value_to_str v)
(** Public API: render to a pre-allocated buffer. *)
let render_to_buffer buf expr env = render_to_buf buf expr env
(** Convenience: render to string. *)
let render_to_html_streaming expr (env : env) =
match !render_to_html_ref expr (Env env) with
| String s -> s
| RawHTML s -> s
| v -> value_to_str v
(** The native OCaml renderer — used by sx_server when SX adapter isn't loaded. *)
let do_render_to_html expr (env_val : value) =
match !render_to_html_ref expr env_val with
| String s -> s
| RawHTML s -> s
| v -> value_to_str v
(** Render via the SX adapter (render-to-html from adapter-html.sx).
Falls back to the native ref if the SX adapter isn't loaded. *)
let sx_render_to_html (render_env : env) expr (eval_env : env) =
if Sx_types.env_has render_env "render-to-html" then
let fn = Sx_types.env_get render_env "render-to-html" in
let result = Sx_ref.cek_call fn (List [expr; Env eval_env]) in
match result with String s -> s | RawHTML s -> s | _ -> value_to_str result
else
do_render_to_html expr (Env eval_env)
(* ====================================================================== *)
(* Setup — bind render primitives in an env and wire up the ref *)
(* ====================================================================== *)
let is_html_tag name = List.mem name html_tags_list
let is_void name = List.mem name void_elements_list
(* escape_html_str: takes raw OCaml string, returns raw string — for callers *)
let escape_html_str = escape_html_raw
let setup_render_env (raw_env : env) =
let env = Env raw_env in
let bind name fn =
ignore (Sx_types.env_bind raw_env name (NativeFn (name, fn)))
in
bind "render-html" (fun args ->
match args with
| [String src] ->
let exprs = Sx_parser.parse_all src in
let expr = match exprs with
| [e] -> e
| [] -> Nil
| _ -> List (Symbol "do" :: exprs)
in
!render_to_html_ref expr env
| [expr] ->
!render_to_html_ref expr env
| [expr; Env e] ->
!render_to_html_ref expr (Env e)
| _ -> String "");
bind "render-to-html" (fun args ->
match args with
| [String src] ->
let exprs = Sx_parser.parse_all src in
let expr = match exprs with
| [e] -> e
| [] -> Nil
| _ -> List (Symbol "do" :: exprs)
in
!render_to_html_ref expr env
| [expr] ->
!render_to_html_ref expr env
| [expr; Env e] ->
!render_to_html_ref expr (Env e)
| _ -> String "")