giles
daeecab310
Split monolithic render.sx into core (tag registries, shared utils) plus four adapter .sx files: adapter-html (server HTML strings), adapter-sx (SX wire format), adapter-dom (browser DOM nodes), and engine (SxEngine triggers, morphing, swaps). All adapters written in s-expressions with platform interface declarations for JS bridge functions. Bootstrap compiler now accepts --adapters flag to emit targeted builds: -a html → server-only (1108 lines) -a dom,engine → browser-only (1634 lines) -a html,sx → server with SX wire (1169 lines) (default) → all adapters (1800 lines) Fixes: keyword arg i-counter desync in reduce across all adapters, render-aware special forms (let/if/when/cond/map) in HTML adapter, component children double-escaping, ~prefixed macro dispatch. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
470 lines
17 KiB
Plaintext
470 lines
17 KiB
Plaintext
;; ==========================================================================
|
|
;; adapter-dom.sx — DOM rendering adapter
|
|
;;
|
|
;; Renders SX expressions to live DOM nodes. Browser-only.
|
|
;; Mirrors the render-to-html adapter but produces Element/Text/Fragment
|
|
;; nodes instead of HTML strings.
|
|
;;
|
|
;; Depends on:
|
|
;; render.sx — HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS, definition-form?
|
|
;; eval.sx — eval-expr, trampoline, call-component, expand-macro
|
|
;; ==========================================================================
|
|
|
|
(define SVG_NS "http://www.w3.org/2000/svg")
|
|
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-to-dom — main entry point
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-to-dom
|
|
(fn (expr env ns)
|
|
(case (type-of expr)
|
|
;; nil / boolean false / boolean true → empty fragment
|
|
"nil" (create-fragment)
|
|
"boolean" (create-fragment)
|
|
|
|
;; Pre-rendered raw HTML → parse into fragment
|
|
"raw-html" (dom-parse-html (raw-html-content expr))
|
|
|
|
;; String → text node
|
|
"string" (create-text-node expr)
|
|
|
|
;; Number → text node
|
|
"number" (create-text-node (str expr))
|
|
|
|
;; Symbol → evaluate then render
|
|
"symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns)
|
|
|
|
;; Keyword → text
|
|
"keyword" (create-text-node (keyword-name expr))
|
|
|
|
;; Pre-rendered DOM node → pass through
|
|
"dom-node" expr
|
|
|
|
;; Dict → empty
|
|
"dict" (create-fragment)
|
|
|
|
;; List → dispatch
|
|
"list"
|
|
(if (empty? expr)
|
|
(create-fragment)
|
|
(render-dom-list expr env ns))
|
|
|
|
;; Style value → text of class name
|
|
"style-value" (create-text-node (style-value-class expr))
|
|
|
|
;; Fallback
|
|
:else (create-text-node (str expr)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-list — dispatch on list head
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-list
|
|
(fn (expr env ns)
|
|
(let ((head (first expr)))
|
|
(cond
|
|
;; Symbol head — dispatch on name
|
|
(= (type-of head) "symbol")
|
|
(let ((name (symbol-name head))
|
|
(args (rest expr)))
|
|
(cond
|
|
;; raw! → insert unescaped HTML
|
|
(= name "raw!")
|
|
(render-dom-raw args env)
|
|
|
|
;; <> → fragment
|
|
(= name "<>")
|
|
(render-dom-fragment args env ns)
|
|
|
|
;; html: prefix → force element rendering
|
|
(starts-with? name "html:")
|
|
(render-dom-element (slice name 5) args env ns)
|
|
|
|
;; Render-aware special forms
|
|
(render-dom-form? name)
|
|
(if (and (contains? HTML_TAGS name)
|
|
(or (and (> (len args) 0)
|
|
(= (type-of (first args)) "keyword"))
|
|
ns))
|
|
;; Ambiguous: tag name that's also a form — treat as tag
|
|
;; when keyword arg or namespace present
|
|
(render-dom-element name args env ns)
|
|
(dispatch-render-form name expr env ns))
|
|
|
|
;; Macro expansion
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(render-to-dom
|
|
(expand-macro (env-get env name) args env)
|
|
env ns)
|
|
|
|
;; HTML tag
|
|
(contains? HTML_TAGS name)
|
|
(render-dom-element name args env ns)
|
|
|
|
;; Component (~name)
|
|
(starts-with? name "~")
|
|
(let ((comp (env-get env name)))
|
|
(if (component? comp)
|
|
(render-dom-component comp args env ns)
|
|
(render-dom-unknown-component name)))
|
|
|
|
;; Custom element (hyphenated with keyword attrs)
|
|
(and (> (index-of name "-") 0)
|
|
(> (len args) 0)
|
|
(= (type-of (first args)) "keyword"))
|
|
(render-dom-element name args env ns)
|
|
|
|
;; Inside SVG/MathML namespace — treat as element
|
|
ns
|
|
(render-dom-element name args env ns)
|
|
|
|
;; Fallback — evaluate then render
|
|
:else
|
|
(render-to-dom (trampoline (eval-expr expr env)) env ns)))
|
|
|
|
;; Lambda or list head → evaluate
|
|
(or (lambda? head) (= (type-of head) "list"))
|
|
(render-to-dom (trampoline (eval-expr expr env)) env ns)
|
|
|
|
;; Data list
|
|
:else
|
|
(let ((frag (create-fragment)))
|
|
(for-each (fn (x) (dom-append frag (render-to-dom x env ns))) expr)
|
|
frag)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-element — create a DOM element with attrs and children
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-element
|
|
(fn (tag args env ns)
|
|
;; Detect namespace from tag
|
|
(let ((new-ns (cond (= tag "svg") SVG_NS
|
|
(= tag "math") MATH_NS
|
|
:else ns))
|
|
(el (dom-create-element tag new-ns))
|
|
(extra-class nil))
|
|
|
|
;; Process args: keywords → attrs, others → children
|
|
(reduce
|
|
(fn (state arg)
|
|
(let ((skip (get state "skip")))
|
|
(if skip
|
|
(assoc state "skip" false "i" (inc (get state "i")))
|
|
(if (and (= (type-of arg) "keyword")
|
|
(< (inc (get state "i")) (len args)))
|
|
;; Keyword arg → attribute
|
|
(let ((attr-name (keyword-name arg))
|
|
(attr-val (trampoline
|
|
(eval-expr
|
|
(nth args (inc (get state "i")))
|
|
env))))
|
|
(cond
|
|
;; nil or false → skip
|
|
(or (nil? attr-val) (= attr-val false))
|
|
nil
|
|
;; :style StyleValue → convert to class
|
|
(and (= attr-name "style") (style-value? attr-val))
|
|
(set! extra-class (style-value-class attr-val))
|
|
;; Boolean attr
|
|
(contains? BOOLEAN_ATTRS attr-name)
|
|
(when attr-val (dom-set-attr el attr-name ""))
|
|
;; true → empty attr
|
|
(= attr-val true)
|
|
(dom-set-attr el attr-name "")
|
|
;; Normal attr
|
|
:else
|
|
(dom-set-attr el attr-name (str attr-val)))
|
|
(assoc state "skip" true "i" (inc (get state "i"))))
|
|
|
|
;; Positional arg → child
|
|
(do
|
|
(when (not (contains? VOID_ELEMENTS tag))
|
|
(dom-append el (render-to-dom arg env new-ns)))
|
|
(assoc state "i" (inc (get state "i"))))))))
|
|
(dict "i" 0 "skip" false)
|
|
args)
|
|
|
|
;; Merge StyleValue class
|
|
(when extra-class
|
|
(let ((existing (dom-get-attr el "class")))
|
|
(dom-set-attr el "class"
|
|
(if existing (str existing " " extra-class) extra-class))))
|
|
|
|
el)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-component — expand and render a component
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-component
|
|
(fn (comp args env ns)
|
|
;; Parse kwargs and children, bind into component env, render body.
|
|
(let ((kwargs (dict))
|
|
(children (list)))
|
|
;; Separate keyword args from positional children
|
|
(reduce
|
|
(fn (state arg)
|
|
(let ((skip (get state "skip")))
|
|
(if skip
|
|
(assoc state "skip" false "i" (inc (get state "i")))
|
|
(if (and (= (type-of arg) "keyword")
|
|
(< (inc (get state "i")) (len args)))
|
|
;; Keyword arg — evaluate in caller's env
|
|
(let ((val (trampoline
|
|
(eval-expr (nth args (inc (get state "i"))) env))))
|
|
(dict-set! kwargs (keyword-name arg) val)
|
|
(assoc state "skip" true "i" (inc (get state "i"))))
|
|
(do
|
|
(append! children arg)
|
|
(assoc state "i" (inc (get state "i"))))))))
|
|
(dict "i" 0 "skip" false)
|
|
args)
|
|
|
|
;; Build component env: closure + caller env + params
|
|
(let ((local (env-merge (component-closure comp) env)))
|
|
;; Bind params from kwargs
|
|
(for-each
|
|
(fn (p)
|
|
(env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
|
(component-params comp))
|
|
|
|
;; If component accepts children, pre-render them to a fragment
|
|
(when (component-has-children? comp)
|
|
(let ((child-frag (create-fragment)))
|
|
(for-each
|
|
(fn (c) (dom-append child-frag (render-to-dom c env ns)))
|
|
children)
|
|
(env-set! local "children" child-frag)))
|
|
|
|
(render-to-dom (component-body comp) local ns)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-fragment — render children into a DocumentFragment
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-fragment
|
|
(fn (args env ns)
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (x) (dom-append frag (render-to-dom x env ns)))
|
|
args)
|
|
frag)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-raw — insert unescaped content
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-raw
|
|
(fn (args env)
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (arg)
|
|
(let ((val (trampoline (eval-expr arg env))))
|
|
(cond
|
|
(= (type-of val) "string")
|
|
(dom-append frag (dom-parse-html val))
|
|
(= (type-of val) "dom-node")
|
|
(dom-append frag (dom-clone val))
|
|
(not (nil? val))
|
|
(dom-append frag (create-text-node (str val))))))
|
|
args)
|
|
frag)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-dom-unknown-component — visible warning element
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-dom-unknown-component
|
|
(fn (name)
|
|
(let ((el (dom-create-element "div" nil)))
|
|
(dom-set-attr el "style"
|
|
"background:#fef2f2;border:1px solid #fca5a5;color:#991b1b;padding:4px 8px;margin:2px;border-radius:4px;font-size:12px;font-family:monospace")
|
|
(dom-append el (create-text-node (str "Unknown component: " name)))
|
|
el)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Render-aware special forms for DOM output
|
|
;; --------------------------------------------------------------------------
|
|
;; These forms need special handling in DOM rendering because they
|
|
;; produce DOM nodes rather than evaluated values.
|
|
|
|
(define RENDER_DOM_FORMS
|
|
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
|
|
"define" "defcomp" "defmacro" "defstyle" "defkeyframes" "defhandler"
|
|
"map" "map-indexed" "filter" "for-each"))
|
|
|
|
(define render-dom-form?
|
|
(fn (name)
|
|
(contains? RENDER_DOM_FORMS name)))
|
|
|
|
(define dispatch-render-form
|
|
(fn (name expr env ns)
|
|
(cond
|
|
;; if
|
|
(= name "if")
|
|
(let ((cond-val (trampoline (eval-expr (nth expr 1) env))))
|
|
(if cond-val
|
|
(render-to-dom (nth expr 2) env ns)
|
|
(if (> (len expr) 3)
|
|
(render-to-dom (nth expr 3) env ns)
|
|
(create-fragment))))
|
|
|
|
;; when
|
|
(= name "when")
|
|
(if (not (trampoline (eval-expr (nth expr 1) env)))
|
|
(create-fragment)
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (i)
|
|
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
|
(range 2 (len expr)))
|
|
frag))
|
|
|
|
;; cond
|
|
(= name "cond")
|
|
(let ((branch (eval-cond (rest expr) env)))
|
|
(if branch
|
|
(render-to-dom branch env ns)
|
|
(create-fragment)))
|
|
|
|
;; case
|
|
(= name "case")
|
|
(render-to-dom (trampoline (eval-expr expr env)) env ns)
|
|
|
|
;; let / let*
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (process-bindings (nth expr 1) env))
|
|
(frag (create-fragment)))
|
|
(for-each
|
|
(fn (i)
|
|
(dom-append frag (render-to-dom (nth expr i) local ns)))
|
|
(range 2 (len expr)))
|
|
frag)
|
|
|
|
;; begin / do
|
|
(or (= name "begin") (= name "do"))
|
|
(let ((frag (create-fragment)))
|
|
(for-each
|
|
(fn (i)
|
|
(dom-append frag (render-to-dom (nth expr i) env ns)))
|
|
(range 1 (len expr)))
|
|
frag)
|
|
|
|
;; Definition forms — eval for side effects
|
|
(definition-form? name)
|
|
(do (trampoline (eval-expr expr env)) (create-fragment))
|
|
|
|
;; map
|
|
(= name "map")
|
|
(let ((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env)))
|
|
(frag (create-fragment)))
|
|
(for-each
|
|
(fn (item)
|
|
(let ((val (if (lambda? f)
|
|
(render-lambda-dom f (list item) env ns)
|
|
(render-to-dom (apply f (list item)) env ns))))
|
|
(dom-append frag val)))
|
|
coll)
|
|
frag)
|
|
|
|
;; map-indexed
|
|
(= name "map-indexed")
|
|
(let ((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env)))
|
|
(frag (create-fragment)))
|
|
(for-each-indexed
|
|
(fn (i item)
|
|
(let ((val (if (lambda? f)
|
|
(render-lambda-dom f (list i item) env ns)
|
|
(render-to-dom (apply f (list i item)) env ns))))
|
|
(dom-append frag val)))
|
|
coll)
|
|
frag)
|
|
|
|
;; filter — evaluate fully then render
|
|
(= name "filter")
|
|
(render-to-dom (trampoline (eval-expr expr env)) env ns)
|
|
|
|
;; for-each (render variant)
|
|
(= name "for-each")
|
|
(let ((f (trampoline (eval-expr (nth expr 1) env)))
|
|
(coll (trampoline (eval-expr (nth expr 2) env)))
|
|
(frag (create-fragment)))
|
|
(for-each
|
|
(fn (item)
|
|
(let ((val (if (lambda? f)
|
|
(render-lambda-dom f (list item) env ns)
|
|
(render-to-dom (apply f (list item)) env ns))))
|
|
(dom-append frag val)))
|
|
coll)
|
|
frag)
|
|
|
|
;; Fallback
|
|
:else
|
|
(render-to-dom (trampoline (eval-expr expr env)) env ns))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; render-lambda-dom — render a lambda body in DOM context
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define render-lambda-dom
|
|
(fn (f args env ns)
|
|
;; Bind lambda params and render body as DOM
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(for-each-indexed
|
|
(fn (i p)
|
|
(env-set! local p (nth args i)))
|
|
(lambda-params f))
|
|
(render-to-dom (lambda-body f) local ns))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — DOM adapter
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Element creation:
|
|
;; (dom-create-element tag ns) → Element (ns=nil for HTML, string for SVG/MathML)
|
|
;; (create-text-node s) → Text node
|
|
;; (create-fragment) → DocumentFragment
|
|
;;
|
|
;; Tree mutation:
|
|
;; (dom-append parent child) → void (appendChild)
|
|
;; (dom-set-attr el name val) → void (setAttribute)
|
|
;; (dom-get-attr el name) → string or nil (getAttribute)
|
|
;;
|
|
;; Content parsing:
|
|
;; (dom-parse-html s) → DocumentFragment from HTML string
|
|
;; (dom-clone node) → deep clone of a DOM node
|
|
;;
|
|
;; Type checking:
|
|
;; DOM nodes have type-of → "dom-node"
|
|
;;
|
|
;; From render.sx:
|
|
;; HTML_TAGS, VOID_ELEMENTS, BOOLEAN_ATTRS, definition-form?
|
|
;; style-value?, style-value-class
|
|
;;
|
|
;; From eval.sx:
|
|
;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond
|
|
;; env-has?, env-get, env-set!, env-merge
|
|
;; lambda?, component?, macro?
|
|
;; lambda-closure, lambda-params, lambda-body
|
|
;; component-params, component-body, component-closure,
|
|
;; component-has-children?, component-name
|
|
;;
|
|
;; Iteration:
|
|
;; (for-each-indexed fn coll) → call fn(index, item) for each element
|
|
;; --------------------------------------------------------------------------
|