(* 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 "&" | '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | '"' -> Buffer.add_string buf """ | 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 "