#!/usr/bin/env python3 """ Bootstrap the SX HTML renderer to native OCaml. Reads spec/render.sx (helpers) and web/adapter-html.sx (dispatch), combines them, and transpiles to sx_render.ml. Performance-critical functions (escape_html, render_attrs) are provided as native OCaml in the PREAMBLE. Web-specific renderers (lake, marsh, island) are appended in FIXUPS. Usage: python3 hosts/ocaml/bootstrap_render.py """ from __future__ import annotations import os import sys _HERE = os.path.dirname(os.path.abspath(__file__)) _PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..")) sys.path.insert(0, _PROJECT) from shared.sx.parser import parse_all, serialize from shared.sx.types import Symbol, Keyword def extract_defines(source: str) -> list[tuple[str, list]]: """Parse .sx source, return list of (name, define-expr) for top-level defines.""" exprs = parse_all(source) defines = [] for expr in exprs: if isinstance(expr, list) and expr and isinstance(expr[0], Symbol): if expr[0].name == "define": name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1]) defines.append((name, expr)) return defines def strip_type_annotations(expr): """Recursively strip :as type annotations from param lists. Transforms (name :as type) → name in function parameter positions.""" if isinstance(expr, list): # Check if this is a typed param: (name :as type) if (len(expr) == 3 and isinstance(expr[0], Symbol) and isinstance(expr[1], Keyword) and expr[1].name == "as"): return expr[0] # just the name # Check for param list patterns — list where first element is a symbol # and contains :as keywords new = [] for item in expr: new.append(strip_type_annotations(item)) return new return expr PREAMBLE = """\ (* 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" ] """ FIXUPS = """ (* ====================================================================== *) (* 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 "&" | '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | '"' -> Buffer.add_string buf """ | 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 "") """ def main(): import tempfile from shared.sx.ocaml_sync import OcamlSync # Load the transpiler into OCaml kernel bridge = OcamlSync() transpiler_path = os.path.join(_HERE, "transpiler.sx") bridge.load(transpiler_path) # Read source files spec_path = os.path.join(_PROJECT, "spec", "render.sx") adapter_path = os.path.join(_PROJECT, "web", "adapter-html.sx") with open(spec_path) as f: spec_src = f.read() with open(adapter_path) as f: adapter_src = f.read() spec_defines = extract_defines(spec_src) adapter_defines = extract_defines(adapter_src) # Skip: performance-critical (native in PREAMBLE) and web-specific (in FIXUPS) skip = { # Native in PREAMBLE for performance "escape-html", "escape-attr", "render-attrs", # OCaml can't have uppercase let bindings; registries need dual types "RENDER_HTML_FORMS", "HTML_TAGS", "VOID_ELEMENTS", "BOOLEAN_ATTRS", # Web-specific — provided as stubs or in FIXUPS "render-html-lake", "render-html-marsh", "render-html-island", "serialize-island-state", } # Combine: spec helpers first (dependency order), then adapter dispatch all_defines = [] for name, expr in spec_defines: if name not in skip: all_defines.append((name, expr)) for name, expr in adapter_defines: if name not in skip: all_defines.append((name, expr)) # Deduplicate — keep last definition for each name seen = {} for i, (n, e) in enumerate(all_defines): seen[n] = i all_defines = [(n, e) for i, (n, e) in enumerate(all_defines) if seen[n] == i] # Strip type annotations from params: (name :as type) → name all_defines = [(name, strip_type_annotations(expr)) for name, expr in all_defines] print(f"Transpiling {len(all_defines)} defines from render spec + adapter...", file=sys.stderr) # Build the defines list and known names for the transpiler defines_list = [[name, expr] for name, expr in all_defines] known_names = [name for name, _ in all_defines] # Add PREAMBLE-provided names so transpiler emits them as direct calls known_names.extend([ "escape-html", "escape-attr", "render-attrs", "eval-expr", "trampoline", "expand-macro", "try-catch", "set-render-active!", "render-html-lake", "render-html-marsh", "render-html-island", "serialize-island-state", "scope-emitted", "RENDER_HTML_FORMS", "cond-scheme?", ]) # Serialize to temp file, load into kernel defines_sx = serialize(defines_list) known_sx = serialize(known_names) with tempfile.NamedTemporaryFile(mode="w", suffix=".sx", delete=False) as tmp: tmp.write(f"(define _defines '{defines_sx})\n") tmp.write(f"(define _known_defines '{known_sx})\n") tmp_path = tmp.name try: bridge.load(tmp_path) finally: os.unlink(tmp_path) # Add renames for uppercase constants and dual-form registries bridge.eval('(dict-set! ml-renames "RENDER_HTML_FORMS" "render_html_forms")') bridge.eval('(dict-set! ml-renames "HTML_TAGS" "html_tags_val")') bridge.eval('(dict-set! ml-renames "VOID_ELEMENTS" "void_elements_val")') bridge.eval('(dict-set! ml-renames "BOOLEAN_ATTRS" "boolean_attrs_val")') bridge.eval('(dict-set! ml-renames "escape-html" "escape_html_val")') bridge.eval('(dict-set! ml-renames "escape-attr" "escape_attr_val")') # Call ml-translate-file — emits as single let rec block result = bridge.eval("(ml-translate-file _defines)") bridge.stop() output = PREAMBLE + "\n(* === Transpiled from render spec + adapter === *)\n" + result + "\n" + FIXUPS # Write output output_path = os.path.join(_HERE, "lib", "sx_render.ml") with open(output_path, "w") as f: f.write(output) print(f"Wrote {len(output)} bytes to {output_path}", file=sys.stderr) print(f" {len(all_defines)} functions transpiled", file=sys.stderr) if __name__ == "__main__": main()