diff --git a/shared/static/wasm/sx/adapter-dom.sx b/shared/static/wasm/sx/adapter-dom.sx
index 2c23bae4..c2fa1d30 100644
--- a/shared/static/wasm/sx/adapter-dom.sx
+++ b/shared/static/wasm/sx/adapter-dom.sx
@@ -1,1375 +1,65 @@
-;; ==========================================================================
-;; 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")
-;; Check if we're inside an island scope.
-;; Uses scope-peek (mutable scope stack) rather than context (CEK continuation)
-;; because with-island-scope uses scope-push!, not provide.
-(define island-scope?
- (fn () (not (nil? (scope-peek "sx-island-scope")))))
+(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope")))))
+(define contains-deref? (fn (expr) (if (not (list? expr)) false (if (empty? expr) false (if (and (= (type-of (first expr)) "symbol") (= (symbol-name (first expr)) "deref")) true (some contains-deref? expr))))))
-;; --------------------------------------------------------------------------
-;; dom-on — dom-listen with post-render hooks
-;;
-;; Wraps dom-listen so that run-post-render-hooks fires after every SX
-;; event handler invocation. This is the SX-level hook integration;
-;; the native dom-listen primitive is a clean addEventListener wrapper.
-;; --------------------------------------------------------------------------
+(define dom-on :effects (io) (fn (el name handler) (dom-listen el name (if (lambda? handler) (if (= 0 (len (lambda-params handler))) (fn (_e) (trampoline (call-lambda handler (list))) (run-post-render-hooks)) (fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks))) handler))))
-(define dom-on :effects [io]
- (fn (el name handler)
- (dom-listen el name
- (if (lambda? handler)
- (if (= 0 (len (lambda-params handler)))
- (fn (_e) (trampoline (call-lambda handler (list))) (run-post-render-hooks))
- (fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks)))
- handler))))
+(define render-to-dom :effects (render) (fn (expr (env :as dict) (ns :as string)) (set-render-active! true) (case (type-of expr) "nil" (create-fragment) "boolean" (create-fragment) "raw-html" (dom-parse-html (raw-html-content expr)) "string" (create-text-node expr) "number" (create-text-node (str expr)) "symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns) "keyword" (create-text-node (keyword-name expr)) "dom-node" expr "spread" (do (when (not (island-scope?)) (scope-emit! "element-attrs" (spread-attrs expr))) expr) "dict" (if (has-key? expr "__host_handle") expr (create-fragment)) "list" (if (empty? expr) (create-fragment) (render-dom-list expr env ns)) :else (if (signal? expr) (if (island-scope?) (reactive-text expr) (create-text-node (str (deref expr)))) (create-text-node (str expr))))))
+(define render-dom-list :effects (render) (fn (expr (env :as dict) (ns :as string)) (let ((head (first expr))) (cond (= (type-of head) "symbol") (let ((name (symbol-name head)) (args (rest expr))) (cond (= name "raw!") (render-dom-raw args env) (= name "<>") (render-dom-fragment args env ns) (= name "lake") (render-dom-lake args env ns) (= name "marsh") (render-dom-marsh args env ns) (starts-with? name "html:") (render-dom-element (slice name 5) args env ns) (render-dom-form? name) (if (and (contains? HTML_TAGS name) (or (and (> (len args) 0) (= (type-of (first args)) "keyword")) ns)) (render-dom-element name args env ns) (dispatch-render-form name expr env ns)) (and (env-has? env name) (macro? (env-get env name))) (render-to-dom (expand-macro (env-get env name) args env) env ns) (contains? HTML_TAGS name) (render-dom-element name args env ns) (and (starts-with? name "~") (env-has? env name) (island? (env-get env name))) (if (scope-peek "sx-render-markers") (let ((island (env-get env name)) (marker (dom-create-element "span" nil))) (dom-set-attr marker "data-sx-island" (component-name island)) marker) (render-dom-island (env-get env name) args env ns)) (starts-with? name "~") (let ((comp (env-get env name))) (if (component? comp) (render-dom-component comp args env ns) (render-dom-unknown-component name))) (and (> (index-of name "-") 0) (> (len args) 0) (= (type-of (first args)) "keyword")) (render-dom-element name args env ns) ns (render-dom-element name args env ns) (and (= name "deref") (island-scope?)) (let ((sig-or-val (trampoline (eval-expr (first args) env)))) (if (signal? sig-or-val) (reactive-text sig-or-val) (create-text-node (str (deref sig-or-val))))) (and (island-scope?) (contains-deref? expr)) (reactive-text (computed (fn () (trampoline (eval-expr expr env))))) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))) (or (lambda? head) (= (type-of head) "list")) (render-to-dom (trampoline (eval-expr expr env)) env ns) :else (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) expr) frag)))))
-;; --------------------------------------------------------------------------
-;; render-to-dom — main entry point
-;; --------------------------------------------------------------------------
+(define render-dom-element :effects (render) (fn ((tag :as string) (args :as list) (env :as dict) (ns :as string)) (let ((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns)) (el (dom-create-element tag new-ns))) (scope-push! "element-attrs" nil) (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))) (let ((attr-name (keyword-name arg)) (attr-expr (nth args (inc (get state "i"))))) (cond (starts-with? attr-name "on-") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (callable? attr-val) (dom-on el (slice attr-name 3) attr-val))) (= attr-name "bind") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (signal? attr-val) (bind-input el attr-val))) (= attr-name "ref") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dict-set! attr-val "current" el)) (= attr-name "key") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dom-set-attr el "key" (str attr-val))) (island-scope?) (reactive-attr el attr-name (fn () (trampoline (eval-expr attr-expr env)))) :else (let ((attr-val (trampoline (eval-expr attr-expr env)))) (cond (or (nil? attr-val) (= attr-val false)) nil (contains? BOOLEAN_ATTRS attr-name) (when attr-val (dom-set-attr el attr-name "")) (= attr-val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str attr-val))))) (assoc state "skip" true "i" (inc (get state "i")))) (do (when (not (contains? VOID_ELEMENTS tag)) (let ((child (render-to-dom arg env new-ns))) (cond (and (spread? child) (island-scope?)) (reactive-spread el (fn () (render-to-dom arg env new-ns))) (spread? child) nil :else (dom-append el child)))) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (for-each (fn (spread-dict) (for-each (fn ((key :as string)) (let ((val (dict-get spread-dict key))) (if (= key "class") (let ((existing (dom-get-attr el "class"))) (dom-set-attr el "class" (if (and existing (not (= existing ""))) (str existing " " val) val))) (if (= key "style") (let ((existing (dom-get-attr el "style"))) (dom-set-attr el "style" (if (and existing (not (= existing ""))) (str existing ";" val) val))) (dom-set-attr el key (str val)))))) (keys spread-dict))) (scope-emitted "element-attrs")) (scope-pop! "element-attrs") el)))
-(define render-to-dom :effects [render]
- (fn (expr (env :as dict) (ns :as string))
- (set-render-active! true)
- (case (type-of expr)
- ;; nil / boolean false / boolean true → empty fragment
- "nil" (create-fragment)
- "boolean" (create-fragment)
+(define render-dom-component :effects (render) (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string)) (let ((kwargs (dict)) (children (list))) (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))) (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) (let ((local (env-merge (component-closure comp) env))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params comp)) (when (component-has-children? comp) (let ((child-frag (create-fragment))) (for-each (fn (c) (let ((result (render-to-dom c env ns))) (when (not (spread? result)) (dom-append child-frag result)))) children) (env-bind! local "children" child-frag))) (render-to-dom (component-body comp) local ns)))))
- ;; Pre-rendered raw HTML → parse into fragment
- "raw-html" (dom-parse-html (raw-html-content expr))
+(define render-dom-fragment :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) args) frag)))
- ;; String → text node
- "string" (create-text-node expr)
+(define render-dom-raw :effects (render) (fn ((args :as list) (env :as dict)) (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)))
- ;; Number → text node
- "number" (create-text-node (str expr))
+(define render-dom-unknown-component :effects (render) (fn ((name :as string)) (error (str "Unknown component: " name))))
- ;; Symbol → evaluate then render
- "symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns)
+(define RENDER_DOM_FORMS (list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do" "define" "defcomp" "defisland" "defmacro" "defstyle" "map" "map-indexed" "filter" "for-each" "portal" "error-boundary" "scope" "provide"))
- ;; Keyword → text
- "keyword" (create-text-node (keyword-name expr))
+(define render-dom-form? :effects () (fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
- ;; Pre-rendered DOM node → pass through
- "dom-node" expr
+(define dispatch-render-form :effects (render) (fn ((name :as string) expr (env :as dict) (ns :as string)) (cond (= name "if") (if (island-scope?) (let ((marker (create-comment "r-if")) (current-nodes (list)) (initial-result nil)) (effect (fn () (let ((result (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)))))) (if (dom-parent marker) (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)) (set! initial-result result))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (set! current-nodes (if (dom-is-fragment? initial-result) (dom-child-nodes initial-result) (list initial-result))) (dom-append frag initial-result)) frag))) (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))))) (= name "when") (if (island-scope?) (let ((marker (create-comment "r-when")) (current-nodes (list)) (initial-result nil)) (effect (fn () (if (dom-parent marker) (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag)))) (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (set! initial-result frag)))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) (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))) (= name "cond") (if (island-scope?) (let ((marker (create-comment "r-cond")) (current-nodes (list)) (initial-result nil)) (effect (fn () (let ((branch (eval-cond (rest expr) env))) (if (dom-parent marker) (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)))) (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (set! initial-result result))))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) (let ((branch (eval-cond (rest expr) env))) (if branch (render-to-dom branch env ns) (create-fragment)))) (= name "case") (render-to-dom (trampoline (eval-expr expr env)) env ns) (or (= name "let") (= name "let*")) (let ((local (process-bindings (nth expr 1) env))) (if (= (len expr) 3) (render-to-dom (nth expr 2) local ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) local ns))) (when (not (spread? result)) (dom-append frag result)))) (range 2 (len expr))) frag))) (= name "letrec") (let ((bindings (nth expr 1)) (body (slice expr 2)) (local (env-extend env))) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-bind! local pname nil))) bindings) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-set! local pname (trampoline (eval-expr (nth pair 1) local))))) bindings) (when (> (len body) 1) (for-each (fn (e) (trampoline (eval-expr e local))) (init body))) (render-to-dom (last body) local ns)) (or (= name "begin") (= name "do")) (if (= (len expr) 2) (render-to-dom (nth expr 1) env ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) env ns))) (when (not (spread? result)) (dom-append frag result)))) (range 1 (len expr))) frag)) (definition-form? name) (do (trampoline (eval-expr expr env)) (create-fragment)) (= name "map") (let ((coll-expr (nth expr 2))) (if (and (island-scope?) (= (type-of coll-expr) "list") (> (len coll-expr) 1) (= (type-of (first coll-expr)) "symbol") (= (symbol-name (first coll-expr)) "deref")) (let ((f (trampoline (eval-expr (nth expr 1) env))) (sig (trampoline (eval-expr (nth coll-expr 1) env)))) (if (signal? sig) (reactive-list f sig env ns) (let ((coll (deref sig)) (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))) (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))) (= 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) (= name "filter") (render-to-dom (trampoline (eval-expr expr env)) env ns) (= name "portal") (render-dom-portal (rest expr) env ns) (= name "error-boundary") (render-dom-error-boundary (rest expr) env ns) (= 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) (= name "scope") (let ((scope-name (trampoline (eval-expr (nth expr 1) env))) (rest-args (slice expr 2)) (scope-val nil) (body-exprs nil) (frag (create-fragment))) (if (and (>= (len rest-args) 2) (= (type-of (first rest-args)) "keyword") (= (keyword-name (first rest-args)) "value")) (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set! body-exprs (slice rest-args 2))) (set! body-exprs rest-args)) (scope-push! scope-name scope-val) (for-each (fn (e) (dom-append frag (render-to-dom e env ns))) body-exprs) (scope-pop! scope-name) frag) (= name "provide") (let ((prov-name (trampoline (eval-expr (nth expr 1) env))) (prov-val (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (scope-push! prov-name prov-val) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 3 (len expr))) (scope-pop! prov-name) frag) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
- ;; Spread → emit attrs to nearest element provider, pass through for reactive-spread
- ;; Inside islands, reactive-spread handles attr application directly —
- ;; skip scope emission to avoid double/triple application.
- "spread" (do (when (not (island-scope?))
- (scope-emit! "element-attrs" (spread-attrs expr)))
- expr)
+(define render-lambda-dom :effects (render) (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string)) (let ((local (env-merge (lambda-closure f) env))) (for-each-indexed (fn (i p) (env-bind! local p (nth args i))) (lambda-params f)) (render-to-dom (lambda-body f) local ns))))
- ;; Dict → check for host DOM node, else empty fragment
- "dict" (if (has-key? expr "__host_handle")
- expr ;; Host DOM node (text node, element, etc.) — pass through
- (create-fragment))
+(define render-dom-island :effects (render mutation) (fn ((island :as island) (args :as list) (env :as dict) (ns :as string)) (let ((kwargs (dict)) (children (list))) (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))) (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) (let ((local (env-merge (component-closure island) env)) (island-name (component-name island))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params island)) (when (component-has-children? island) (let ((child-frag (create-fragment))) (for-each (fn (c) (dom-append child-frag (render-to-dom c env ns))) children) (env-bind! local "children" child-frag))) (let ((container (dom-create-element "span" nil)) (disposers (list))) (dom-set-attr container "data-sx-island" island-name) (mark-processed! container "island-hydrated") (let ((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns))))) (dom-append container body-dom) (dom-set-data container "sx-disposers" disposers) container))))))
- ;; List → dispatch
- "list"
- (if (empty? expr)
- (create-fragment)
- (render-dom-list expr env ns))
+(define render-dom-lake :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((lake-id nil) (lake-tag "div") (children (list))) (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))) (let ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! lake-id kval) (= kname "tag") (set! lake-tag kval)) (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) (let ((el (dom-create-element lake-tag nil))) (dom-set-attr el "data-sx-lake" (or lake-id "")) (for-each (fn (c) (dom-append el (render-to-dom c env ns))) children) el))))
- ;; Signal → reactive text in island scope, deref outside
- :else
- (if (signal? expr)
- (if (island-scope?)
- (reactive-text expr)
- (create-text-node (str (deref expr))))
- (create-text-node (str expr))))))
+(define render-dom-marsh :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((marsh-id nil) (marsh-tag "div") (marsh-transform nil) (children (list))) (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))) (let ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! marsh-id kval) (= kname "tag") (set! marsh-tag kval) (= kname "transform") (set! marsh-transform kval)) (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) (let ((el (dom-create-element marsh-tag nil))) (dom-set-attr el "data-sx-marsh" (or marsh-id "")) (when marsh-transform (dom-set-data el "sx-marsh-transform" marsh-transform)) (dom-set-data el "sx-marsh-env" env) (for-each (fn (c) (dom-append el (render-to-dom c env ns))) children) el))))
+(define reactive-text :effects (render mutation) (fn (sig) (let ((node (create-text-node (str (deref sig))))) (effect (fn () (dom-set-text-content node (str (deref sig))))) node)))
-;; --------------------------------------------------------------------------
-;; render-dom-list — dispatch on list head
-;; --------------------------------------------------------------------------
+(define reactive-attr :effects (render mutation) (fn (el (attr-name :as string) (compute-fn :as lambda)) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (updated (if (empty? existing) attr-name (str existing "," attr-name)))) (dom-set-attr el "data-sx-reactive-attrs" updated)) (effect (fn () (let ((raw (compute-fn))) (let ((val (if (signal? raw) (deref raw) raw))) (cond (or (nil? val) (= val false)) (dom-remove-attr el attr-name) (= val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str val)))))))))
-(define render-dom-list :effects [render]
- (fn (expr (env :as dict) (ns :as string))
- (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)
+(define reactive-spread :effects (render mutation) (fn (el (render-fn :as lambda)) (let ((prev-classes (list)) (prev-extra-keys (list))) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))) (dom-set-attr el "data-sx-reactive-attrs" (if (empty? existing) "_spread" (str existing ",_spread")))) (effect (fn () (when (not (empty? prev-classes)) (let ((current (or (dom-get-attr el "class") "")) (tokens (filter (fn (c) (not (= c ""))) (split current " "))) (kept (filter (fn (c) (not (some (fn (pc) (= pc c)) prev-classes))) tokens))) (if (empty? kept) (dom-remove-attr el "class") (dom-set-attr el "class" (join " " kept))))) (for-each (fn (k) (dom-remove-attr el k)) prev-extra-keys) (let ((result (render-fn))) (if (spread? result) (let ((attrs (spread-attrs result)) (cls-str (or (dict-get attrs "class") "")) (new-classes (filter (fn (c) (not (= c ""))) (split cls-str " "))) (extra-keys (filter (fn (k) (not (= k "class"))) (keys attrs)))) (set! prev-classes new-classes) (set! prev-extra-keys extra-keys) (when (not (empty? new-classes)) (let ((current (or (dom-get-attr el "class") ""))) (dom-set-attr el "class" (if (and current (not (= current ""))) (str current " " cls-str) cls-str)))) (for-each (fn (k) (dom-set-attr el k (str (dict-get attrs k)))) extra-keys) (run-post-render-hooks)) (do (set! prev-classes (list)) (set! prev-extra-keys (list))))))))))
- ;; <> → fragment
- (= name "<>")
- (render-dom-fragment args env ns)
+(define reactive-fragment :effects (render mutation) (fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string)) (let ((marker (create-comment "island-fragment")) (current-nodes (list))) (effect (fn () (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (test-fn) (let ((frag (render-fn))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag))))) marker)))
- ;; lake — server-morphable slot within an island
- (= name "lake")
- (render-dom-lake args env ns)
+(define render-list-item :effects (render) (fn ((map-fn :as lambda) item (env :as dict) (ns :as string)) (if (lambda? map-fn) (render-lambda-dom map-fn (list item) env ns) (render-to-dom (apply map-fn (list item)) env ns))))
- ;; marsh — reactive server-morphable slot within an island
- (= name "marsh")
- (render-dom-marsh args env ns)
+(define extract-key :effects (render) (fn (node (index :as number)) (let ((k (dom-get-attr node "key"))) (if k (do (dom-remove-attr node "key") k) (let ((dk (dom-get-data node "key"))) (if dk (str dk) (str "__idx_" index)))))))
- ;; html: prefix → force element rendering
- (starts-with? name "html:")
- (render-dom-element (slice name 5) args env ns)
+(define reactive-list :effects (render mutation) (fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string)) (let ((container (create-fragment)) (marker (create-comment "island-list")) (key-map (dict)) (key-order (list))) (dom-append container marker) (effect (fn () (let ((items (deref items-sig))) (if (dom-parent marker) (let ((new-map (dict)) (new-keys (list)) (has-keys false)) (for-each-indexed (fn (idx item) (let ((rendered (render-list-item map-fn item env ns)) (key (extract-key rendered idx))) (when (and (not has-keys) (not (starts-with? key "__idx_"))) (set! has-keys true)) (if (dict-has? key-map key) (dict-set! new-map key (dict-get key-map key)) (dict-set! new-map key rendered)) (append! new-keys key))) items) (if (not has-keys) (do (dom-remove-children-after marker) (let ((frag (create-fragment))) (for-each (fn (k) (dom-append frag (dict-get new-map k))) new-keys) (dom-insert-after marker frag))) (do (for-each (fn (old-key) (when (not (dict-has? new-map old-key)) (dom-remove (dict-get key-map old-key)))) key-order) (let ((cursor marker)) (for-each (fn (k) (let ((node (dict-get new-map k)) (next (dom-next-sibling cursor))) (when (not (identical? node next)) (dom-insert-after cursor node)) (set! cursor node))) new-keys)))) (set! key-map new-map) (set! key-order new-keys)) (for-each-indexed (fn (idx item) (let ((rendered (render-list-item map-fn item env ns)) (key (extract-key rendered idx))) (dict-set! key-map key rendered) (append! key-order key) (dom-append container rendered))) items))))) container)))
- ;; 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)
-
- ;; Island (~name) — reactive component
- (and (starts-with? name "~")
- (env-has? env name)
- (island? (env-get env name)))
- ;; In marker mode (sx-render for swap), create empty marker span
- ;; that post-swap will hydrate. Otherwise, full render.
- (if (scope-peek "sx-render-markers")
- (let ((island (env-get env name))
- (marker (dom-create-element "span" nil)))
- (dom-set-attr marker "data-sx-island" (component-name island))
- marker)
- (render-dom-island (env-get env 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)
-
- ;; deref in island scope → reactive text node
- (and (= name "deref") (island-scope?))
- (let ((sig-or-val (trampoline (eval-expr (first args) env))))
- (if (signal? sig-or-val)
- (reactive-text sig-or-val)
- (create-text-node (str (deref sig-or-val)))))
-
- ;; 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)
- (let ((result (render-to-dom x env ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- expr)
- frag)))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-element — create a DOM element with attrs and children
-;; --------------------------------------------------------------------------
-
-(define render-dom-element :effects [render]
- (fn ((tag :as string) (args :as list) (env :as dict) (ns :as string))
- ;; 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)))
-
- ;; Provide scope for spread emit! — deeply nested spreads emit here
- (scope-push! "element-attrs" 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-expr (nth args (inc (get state "i")))))
- (cond
- ;; Event handler: evaluate eagerly, bind listener
- (starts-with? attr-name "on-")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (when (callable? attr-val)
- (dom-on el (slice attr-name 3) attr-val)))
- ;; Two-way input binding: :bind signal
- (= attr-name "bind")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (when (signal? attr-val) (bind-input el attr-val)))
- ;; ref: set ref.current to this element
- (= attr-name "ref")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (dict-set! attr-val "current" el))
- ;; key: reconciliation hint, evaluate eagerly (not reactive)
- (= attr-name "key")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (dom-set-attr el "key" (str attr-val)))
- ;; Inside island scope: reactive attribute binding.
- ;; The effect tracks signal deps automatically — if none
- ;; are deref'd, it fires once and never again (safe).
- (island-scope?)
- (reactive-attr el attr-name
- (fn () (trampoline (eval-expr attr-expr env))))
- ;; Static attribute (outside islands)
- :else
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (cond
- (or (nil? attr-val) (= attr-val false)) nil
- (contains? BOOLEAN_ATTRS attr-name)
- (when attr-val (dom-set-attr el attr-name ""))
- (= attr-val true)
- (dom-set-attr el attr-name "")
- :else
- (dom-set-attr el attr-name (str attr-val)))))
- (assoc state "skip" true "i" (inc (get state "i"))))
-
- ;; Positional arg → child (or spread → merge attrs onto element)
- (do
- (when (not (contains? VOID_ELEMENTS tag))
- (let ((child (render-to-dom arg env new-ns)))
- (cond
- ;; Reactive spread: track signal deps, update attrs on change
- (and (spread? child) (island-scope?))
- (reactive-spread el (fn () (render-to-dom arg env new-ns)))
- ;; Static spread: already emitted via provide, skip
- (spread? child) nil
- ;; Normal child: append to element
- :else
- (dom-append el child))))
- (assoc state "i" (inc (get state "i"))))))))
- (dict "i" 0 "skip" false)
- args)
-
- ;; Collect emitted spread attrs and merge onto DOM element
- (for-each
- (fn (spread-dict)
- (for-each
- (fn ((key :as string))
- (let ((val (dict-get spread-dict key)))
- (if (= key "class")
- (let ((existing (dom-get-attr el "class")))
- (dom-set-attr el "class"
- (if (and existing (not (= existing "")))
- (str existing " " val)
- val)))
- (if (= key "style")
- (let ((existing (dom-get-attr el "style")))
- (dom-set-attr el "style"
- (if (and existing (not (= existing "")))
- (str existing ";" val)
- val)))
- (dom-set-attr el key (str val))))))
- (keys spread-dict)))
- (scope-emitted "element-attrs"))
- (scope-pop! "element-attrs")
-
- el)))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-component — expand and render a component
-;; --------------------------------------------------------------------------
-
-(define render-dom-component :effects [render]
- (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string))
- ;; 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-bind! 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
- ;; Spread values are filtered out (no parent element to merge onto)
- (when (component-has-children? comp)
- (let ((child-frag (create-fragment)))
- (for-each
- (fn (c)
- (let ((result (render-to-dom c env ns)))
- (when (not (spread? result))
- (dom-append child-frag result))))
- children)
- (env-bind! local "children" child-frag)))
-
- (render-to-dom (component-body comp) local ns)))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-fragment — render children into a DocumentFragment
-;; --------------------------------------------------------------------------
-
-(define render-dom-fragment :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((frag (create-fragment)))
- (for-each
- (fn (x)
- (let ((result (render-to-dom x env ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- args)
- frag)))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-raw — insert unescaped content
-;; --------------------------------------------------------------------------
-
-(define render-dom-raw :effects [render]
- (fn ((args :as list) (env :as dict))
- (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 :effects [render]
- (fn ((name :as string))
- (error (str "Unknown component: " name))))
-
-
-;; --------------------------------------------------------------------------
-;; 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*" "letrec" "begin" "do"
- "define" "defcomp" "defisland" "defmacro" "defstyle"
- "map" "map-indexed" "filter" "for-each" "portal"
- "error-boundary" "scope" "provide"))
-
-(define render-dom-form? :effects []
- (fn ((name :as string))
- (contains? RENDER_DOM_FORMS name)))
-
-(define dispatch-render-form :effects [render]
- (fn ((name :as string) expr (env :as dict) (ns :as string))
- (cond
- ;; if — reactive inside islands (re-renders when signal deps change)
- (= name "if")
- (if (island-scope?)
- (let ((marker (create-comment "r-if"))
- (current-nodes (list))
- (initial-result nil))
- ;; Effect runs synchronously on first call, tracking signal deps.
- ;; On first run, store result in initial-result (marker has no parent yet).
- ;; On subsequent runs, swap DOM nodes after marker.
- (effect (fn ()
- (let ((result (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))))))
- (if (dom-parent marker)
- ;; Marker is in DOM — swap nodes
- (do
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes
- (if (dom-is-fragment? result)
- (dom-child-nodes result)
- (list result)))
- (dom-insert-after marker result))
- ;; Marker not yet in DOM (first run) — just save result
- (set! initial-result result)))))
- ;; Spread pass-through: spreads aren't DOM nodes, can't live
- ;; in fragments. Return directly so parent element merges attrs.
- (if (spread? initial-result)
- initial-result
- (let ((frag (create-fragment)))
- (dom-append frag marker)
- (when initial-result
- (set! current-nodes
- (if (dom-is-fragment? initial-result)
- (dom-child-nodes initial-result)
- (list initial-result)))
- (dom-append frag initial-result))
- frag)))
- ;; Static 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 — reactive inside islands
- (= name "when")
- (if (island-scope?)
- (let ((marker (create-comment "r-when"))
- (current-nodes (list))
- (initial-result nil))
- (effect (fn ()
- (if (dom-parent marker)
- ;; In DOM — swap nodes
- (do
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes (list))
- (when (trampoline (eval-expr (nth expr 1) env))
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (dom-append frag (render-to-dom (nth expr i) env ns)))
- (range 2 (len expr)))
- (set! current-nodes (dom-child-nodes frag))
- (dom-insert-after marker frag))))
- ;; First run — save result for fragment
- (when (trampoline (eval-expr (nth expr 1) env))
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (dom-append frag (render-to-dom (nth expr i) env ns)))
- (range 2 (len expr)))
- (set! current-nodes (dom-child-nodes frag))
- (set! initial-result frag))))))
- ;; Spread pass-through
- (if (spread? initial-result)
- initial-result
- (let ((frag (create-fragment)))
- (dom-append frag marker)
- (when initial-result (dom-append frag initial-result))
- frag)))
- ;; Static 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 — reactive inside islands
- (= name "cond")
- (if (island-scope?)
- (let ((marker (create-comment "r-cond"))
- (current-nodes (list))
- (initial-result nil))
- (effect (fn ()
- (let ((branch (eval-cond (rest expr) env)))
- (if (dom-parent marker)
- ;; In DOM — swap nodes
- (do
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes (list))
- (when branch
- (let ((result (render-to-dom branch env ns)))
- (set! current-nodes
- (if (dom-is-fragment? result)
- (dom-child-nodes result)
- (list result)))
- (dom-insert-after marker result))))
- ;; First run — save result for fragment
- (when branch
- (let ((result (render-to-dom branch env ns)))
- (set! current-nodes
- (if (dom-is-fragment? result)
- (dom-child-nodes result)
- (list result)))
- (set! initial-result result)))))))
- ;; Spread pass-through
- (if (spread? initial-result)
- initial-result
- (let ((frag (create-fragment)))
- (dom-append frag marker)
- (when initial-result (dom-append frag initial-result))
- frag)))
- ;; Static 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* — single body: pass through (spread propagates). Multi: fragment.
- (or (= name "let") (= name "let*"))
- (let ((local (process-bindings (nth expr 1) env)))
- (if (= (len expr) 3)
- (render-to-dom (nth expr 2) local ns)
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (let ((result (render-to-dom (nth expr i) local ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- (range 2 (len expr)))
- frag)))
-
- ;; letrec — pre-bind all names (nil), evaluate values, render body.
- (= name "letrec")
- (let ((bindings (nth expr 1))
- (body (slice expr 2))
- (local (env-extend env)))
- ;; Phase 1: pre-bind all names to nil
- (for-each (fn (pair)
- (let ((pname (if (= (type-of (first pair)) "symbol")
- (symbol-name (first pair))
- (str (first pair)))))
- (env-bind! local pname nil)))
- bindings)
- ;; Phase 2: evaluate values (all names in scope for mutual recursion)
- (for-each (fn (pair)
- (let ((pname (if (= (type-of (first pair)) "symbol")
- (symbol-name (first pair))
- (str (first pair)))))
- (env-set! local pname (trampoline (eval-expr (nth pair 1) local)))))
- bindings)
- ;; Phase 3: eval non-last body exprs for side effects, render last
- (when (> (len body) 1)
- (for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
- (render-to-dom (last body) local ns))
-
- ;; begin / do — single body: pass through. Multi: fragment.
- (or (= name "begin") (= name "do"))
- (if (= (len expr) 2)
- (render-to-dom (nth expr 1) env ns)
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (let ((result (render-to-dom (nth expr i) env ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- (range 1 (len expr)))
- frag))
-
- ;; Definition forms — eval for side effects
- (definition-form? name)
- (do (trampoline (eval-expr expr env)) (create-fragment))
-
- ;; map — reactive-list when mapping over a signal inside an island
- (= name "map")
- (let ((coll-expr (nth expr 2)))
- (if (and (island-scope?)
- (= (type-of coll-expr) "list")
- (> (len coll-expr) 1)
- (= (type-of (first coll-expr)) "symbol")
- (= (symbol-name (first coll-expr)) "deref"))
- ;; Reactive path: pass signal to reactive-list
- (let ((f (trampoline (eval-expr (nth expr 1) env)))
- (sig (trampoline (eval-expr (nth coll-expr 1) env))))
- (if (signal? sig)
- (reactive-list f sig env ns)
- ;; deref on non-signal: fall through to static
- (let ((coll (deref sig))
- (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)))
- ;; Static path: no island scope or no deref
- (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)
-
- ;; portal — render children into a remote target element
- (= name "portal")
- (render-dom-portal (rest expr) env ns)
-
- ;; error-boundary — catch errors, render fallback
- (= name "error-boundary")
- (render-dom-error-boundary (rest expr) 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)
-
- ;; scope — unified render-time dynamic scope
- (= name "scope")
- (let ((scope-name (trampoline (eval-expr (nth expr 1) env)))
- (rest-args (slice expr 2))
- (scope-val nil)
- (body-exprs nil)
- (frag (create-fragment)))
- ;; Check for :value keyword
- (if (and (>= (len rest-args) 2)
- (= (type-of (first rest-args)) "keyword")
- (= (keyword-name (first rest-args)) "value"))
- (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env)))
- (set! body-exprs (slice rest-args 2)))
- (set! body-exprs rest-args))
- (scope-push! scope-name scope-val)
- (for-each
- (fn (e)
- (dom-append frag (render-to-dom e env ns)))
- body-exprs)
- (scope-pop! scope-name)
- frag)
-
- ;; provide — sugar for scope with value
- (= name "provide")
- (let ((prov-name (trampoline (eval-expr (nth expr 1) env)))
- (prov-val (trampoline (eval-expr (nth expr 2) env)))
- (frag (create-fragment)))
- (scope-push! prov-name prov-val)
- (for-each
- (fn (i)
- (dom-append frag (render-to-dom (nth expr i) env ns)))
- (range 3 (len expr)))
- (scope-pop! prov-name)
- 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 :effects [render]
- (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string))
- ;; Bind lambda params and render body as DOM
- (let ((local (env-merge (lambda-closure f) env)))
- (for-each-indexed
- (fn (i p)
- (env-bind! local p (nth args i)))
- (lambda-params f))
- (render-to-dom (lambda-body f) local ns))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-island — render a reactive island
-;; --------------------------------------------------------------------------
-;;
-;; Islands render like components but wrapped in a reactive context.
-;; The island container element gets data-sx-island and data-sx-state
-;; attributes for identification and hydration.
-;;
-;; Inside the island body, deref calls create reactive DOM subscriptions:
-;; - Text bindings: (deref sig) in text position → reactive text node
-;; - Attribute bindings: (deref sig) in attr → reactive attribute
-;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide
-
-(define render-dom-island :effects [render mutation]
- (fn ((island :as island) (args :as list) (env :as dict) (ns :as string))
- ;; Parse kwargs and children (same as component)
- (let ((kwargs (dict))
- (children (list)))
- (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)))
- (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 island env: closure + caller env + params
- (let ((local (env-merge (component-closure island) env))
- (island-name (component-name island)))
-
- ;; Bind params from kwargs
- (for-each
- (fn (p)
- (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
- (component-params island))
-
- ;; If island accepts children, pre-render them to a fragment
- (when (component-has-children? island)
- (let ((child-frag (create-fragment)))
- (for-each
- (fn (c) (dom-append child-frag (render-to-dom c env ns)))
- children)
- (env-bind! local "children" child-frag)))
-
- ;; Create the island container element
- (let ((container (dom-create-element "span" nil))
- (disposers (list)))
-
- ;; Mark as island + already hydrated (so boot.sx skips it)
- (dom-set-attr container "data-sx-island" island-name)
- (mark-processed! container "island-hydrated")
-
- ;; Render island body inside a scope that tracks disposers
- (let ((body-dom
- (with-island-scope
- (fn (disposable) (append! disposers disposable))
- (fn () (render-to-dom (component-body island) local ns)))))
- (dom-append container body-dom)
-
- ;; Store disposers on the container for cleanup
- (dom-set-data container "sx-disposers" disposers)
-
- container))))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-lake — server-morphable slot within an island
-;; --------------------------------------------------------------------------
-;;
-;; (lake :id "name" children...)
-;;
-;; Renders as children
.
-;; During morph, the server can replace lake content while the surrounding
-;; reactive island DOM is preserved. This is the "water around the rocks" —
-;; server substance flowing through client territory.
-;;
-;; Supports :tag keyword to change wrapper element (default "div").
-
-(define render-dom-lake :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((lake-id nil)
- (lake-tag "div")
- (children (list)))
- (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)))
- (let ((kname (keyword-name arg))
- (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
- (cond
- (= kname "id") (set! lake-id kval)
- (= kname "tag") (set! lake-tag kval))
- (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)
- (let ((el (dom-create-element lake-tag nil)))
- (dom-set-attr el "data-sx-lake" (or lake-id ""))
- (for-each
- (fn (c) (dom-append el (render-to-dom c env ns)))
- children)
- el))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-marsh — reactive server-morphable slot within an island
-;; --------------------------------------------------------------------------
-;;
-;; (marsh :id "name" :tag "div" :transform fn children...)
-;;
-;; Like a lake but reactive: during morph, new content is parsed as SX and
-;; re-evaluated in the island's signal scope. The :transform function (if
-;; present) reshapes server content before evaluation.
-;;
-;; Renders as children
.
-;; Stores the island env and transform on the element for morph retrieval.
-
-(define render-dom-marsh :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((marsh-id nil)
- (marsh-tag "div")
- (marsh-transform nil)
- (children (list)))
- (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)))
- (let ((kname (keyword-name arg))
- (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
- (cond
- (= kname "id") (set! marsh-id kval)
- (= kname "tag") (set! marsh-tag kval)
- (= kname "transform") (set! marsh-transform kval))
- (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)
- (let ((el (dom-create-element marsh-tag nil)))
- (dom-set-attr el "data-sx-marsh" (or marsh-id ""))
- ;; Store transform function and island env for morph retrieval
- (when marsh-transform
- (dom-set-data el "sx-marsh-transform" marsh-transform))
- (dom-set-data el "sx-marsh-env" env)
- (for-each
- (fn (c) (dom-append el (render-to-dom c env ns)))
- children)
- el))))
-
-
-;; --------------------------------------------------------------------------
-;; Reactive DOM rendering helpers
-;; --------------------------------------------------------------------------
-;;
-;; These functions create reactive bindings between signals and DOM nodes.
-;; They are called by the platform's renderDOM when it detects deref
-;; calls inside an island context.
-
-;; reactive-text — create a text node bound to a signal
-;; Used when (deref sig) appears in a text position inside an island.
-(define reactive-text :effects [render mutation]
- (fn (sig)
- (let ((node (create-text-node (str (deref sig)))))
- (effect (fn ()
- (dom-set-text-content node (str (deref sig)))))
- node)))
-
-;; reactive-attr — bind an element attribute to a signal expression
-;; Used when an attribute value contains (deref sig) inside an island.
-;; Marks the attribute name on the element via data-sx-reactive-attrs so
-;; the morph algorithm knows not to overwrite it with server content.
-(define reactive-attr :effects [render mutation]
- (fn (el (attr-name :as string) (compute-fn :as lambda))
- ;; Mark this attribute as reactively managed
- (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
- (updated (if (empty? existing) attr-name (str existing "," attr-name))))
- (dom-set-attr el "data-sx-reactive-attrs" updated))
- (effect (fn ()
- (let ((raw (compute-fn)))
- ;; If compute-fn returned a signal (e.g. from computed), deref it
- ;; to get the actual value and track the dependency
- (let ((val (if (signal? raw) (deref raw) raw)))
- (cond
- (or (nil? val) (= val false))
- (dom-remove-attr el attr-name)
- (= val true)
- (dom-set-attr el attr-name "")
- :else
- (dom-set-attr el attr-name (str val)))))))))
-
-;; reactive-spread — reactively bind spread attrs to parent element.
-;; Used when a child of an element produces a spread inside an island.
-;; Tracks signal deps in the spread expression. When signals change:
-;; old classes are removed, new ones applied. Non-class attrs (data-tw etc.)
-;; are overwritten. Flushes newly collected CSS rules to live stylesheet.
-;;
-;; Multiple reactive spreads on the same element are safe — each tracks
-;; its own class contribution and only removes/adds its own tokens.
-(define reactive-spread :effects [render mutation]
- (fn (el (render-fn :as lambda))
- (let ((prev-classes (list))
- (prev-extra-keys (list)))
- ;; Mark for morph protection
- (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")))
- (dom-set-attr el "data-sx-reactive-attrs"
- (if (empty? existing) "_spread" (str existing ",_spread"))))
- (effect (fn ()
- ;; 1. Remove previously applied classes from element's class list
- (when (not (empty? prev-classes))
- (let ((current (or (dom-get-attr el "class") ""))
- (tokens (filter (fn (c) (not (= c ""))) (split current " ")))
- (kept (filter (fn (c)
- (not (some (fn (pc) (= pc c)) prev-classes)))
- tokens)))
- (if (empty? kept)
- (dom-remove-attr el "class")
- (dom-set-attr el "class" (join " " kept)))))
- ;; 2. Remove previously applied extra attrs
- (for-each (fn (k) (dom-remove-attr el k)) prev-extra-keys)
- ;; 3. Re-evaluate the spread expression (tracks signal deps)
- (let ((result (render-fn)))
- (if (spread? result)
- (let ((attrs (spread-attrs result))
- (cls-str (or (dict-get attrs "class") ""))
- (new-classes (filter (fn (c) (not (= c "")))
- (split cls-str " ")))
- (extra-keys (filter (fn (k) (not (= k "class")))
- (keys attrs))))
- (set! prev-classes new-classes)
- (set! prev-extra-keys extra-keys)
- ;; Append new classes to element
- (when (not (empty? new-classes))
- (let ((current (or (dom-get-attr el "class") "")))
- (dom-set-attr el "class"
- (if (and current (not (= current "")))
- (str current " " cls-str)
- cls-str))))
- ;; Set extra attrs (data-tw, etc.) — simple overwrite
- (for-each (fn (k)
- (dom-set-attr el k (str (dict-get attrs k))))
- extra-keys)
- ;; Flush any newly collected CSS rules to live stylesheet
- (run-post-render-hooks))
- ;; No longer a spread — clear tracked state
- (do
- (set! prev-classes (list))
- (set! prev-extra-keys (list))))))))))
-
-;; reactive-fragment — conditionally render a fragment based on a signal
-;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
-(define reactive-fragment :effects [render mutation]
- (fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string))
- (let ((marker (create-comment "island-fragment"))
- (current-nodes (list)))
- (effect (fn ()
- ;; Remove previous nodes
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes (list))
- ;; If test passes, render and insert after marker
- (when (test-fn)
- (let ((frag (render-fn)))
- (set! current-nodes (dom-child-nodes frag))
- (dom-insert-after marker frag)))))
- marker)))
-
-;; reactive-list — render a keyed list bound to a signal
-;; Used for (map fn (deref items)) inside an island.
-;;
-;; Keyed reconciliation: if rendered elements have a "key" attribute,
-;; existing DOM nodes are reused across updates. Only additions, removals,
-;; and reorderings touch the DOM. Without keys, falls back to clear+rerender.
-
-(define render-list-item :effects [render]
- (fn ((map-fn :as lambda) item (env :as dict) (ns :as string))
- (if (lambda? map-fn)
- (render-lambda-dom map-fn (list item) env ns)
- (render-to-dom (apply map-fn (list item)) env ns))))
-
-(define extract-key :effects [render]
- (fn (node (index :as number))
- ;; Extract key from rendered node: :key attr, data-key, or index fallback
- (let ((k (dom-get-attr node "key")))
- (if k
- (do (dom-remove-attr node "key") k)
- (let ((dk (dom-get-data node "key")))
- (if dk (str dk) (str "__idx_" index)))))))
-
-(define reactive-list :effects [render mutation]
- (fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string))
- (let ((container (create-fragment))
- (marker (create-comment "island-list"))
- (key-map (dict))
- (key-order (list)))
- (dom-append container marker)
- (effect (fn ()
- (let ((items (deref items-sig)))
- (if (dom-parent marker)
- ;; Marker in DOM: reconcile
- (let ((new-map (dict))
- (new-keys (list))
- (has-keys false))
-
- ;; Render or reuse each item
- (for-each-indexed
- (fn (idx item)
- (let ((rendered (render-list-item map-fn item env ns))
- (key (extract-key rendered idx)))
- (when (and (not has-keys)
- (not (starts-with? key "__idx_")))
- (set! has-keys true))
- ;; Reuse existing node if key matches, else use new
- (if (dict-has? key-map key)
- (dict-set! new-map key (dict-get key-map key))
- (dict-set! new-map key rendered))
- (append! new-keys key)))
- items)
-
- (if (not has-keys)
- ;; No keys: simple clear and re-render (original strategy)
- (do
- (dom-remove-children-after marker)
- (let ((frag (create-fragment)))
- (for-each
- (fn (k) (dom-append frag (dict-get new-map k)))
- new-keys)
- (dom-insert-after marker frag)))
-
- ;; Keyed reconciliation
- (do
- ;; Remove stale nodes
- (for-each
- (fn (old-key)
- (when (not (dict-has? new-map old-key))
- (dom-remove (dict-get key-map old-key))))
- key-order)
-
- ;; Reorder/insert to match new key order
- (let ((cursor marker))
- (for-each
- (fn (k)
- (let ((node (dict-get new-map k))
- (next (dom-next-sibling cursor)))
- (when (not (identical? node next))
- (dom-insert-after cursor node))
- (set! cursor node)))
- new-keys))))
-
- ;; Update state for next render
- (set! key-map new-map)
- (set! key-order new-keys))
-
- ;; First run (marker not in DOM yet): render initial items into container
- (for-each-indexed
- (fn (idx item)
- (let ((rendered (render-list-item map-fn item env ns))
- (key (extract-key rendered idx)))
- (dict-set! key-map key rendered)
- (append! key-order key)
- (dom-append container rendered)))
- items)))))
- container)))
-
-
-;; --------------------------------------------------------------------------
-;; bind-input — two-way signal binding for form elements
-;; --------------------------------------------------------------------------
-;;
-;; (bind-input el sig) creates a bidirectional link:
-;; Signal → element: effect updates el.value (or el.checked) when sig changes
-;; Element → signal: input/change listener updates sig when user types
-;;
-;; Handles: input[text/number/email/...], textarea, select, checkbox, radio
-
-(define bind-input :effects [render mutation]
- (fn (el (sig :as signal))
- (let ((input-type (lower (or (dom-get-attr el "type") "")))
- (is-checkbox (or (= input-type "checkbox")
- (= input-type "radio"))))
- ;; Set initial value from signal
- (if is-checkbox
- (dom-set-prop el "checked" (deref sig))
- (dom-set-prop el "value" (str (deref sig))))
- ;; Signal → element (reactive effect)
- (effect (fn ()
- (if is-checkbox
- (dom-set-prop el "checked" (deref sig))
- (let ((v (str (deref sig))))
- (when (!= (dom-get-prop el "value") v)
- (dom-set-prop el "value" v))))))
- ;; Element → signal (event listener)
- (dom-on el (if is-checkbox "change" "input")
- (fn (e)
- (if is-checkbox
- (reset! sig (dom-get-prop el "checked"))
- (reset! sig (dom-get-prop el "value"))))))))
-
-
-;; --------------------------------------------------------------------------
-;; CEK-based reactive rendering (opt-in, deref-as-shift)
-;; --------------------------------------------------------------------------
-;;
-;; When enabled, (deref sig) inside a reactive-reset boundary performs
-;; continuation capture: "the rest of this expression" becomes the subscriber.
-;; No explicit effect() wrapping needed for text/attr bindings.
+(define bind-input :effects (render mutation) (fn (el (sig :as signal)) (let ((input-type (lower (or (dom-get-attr el "type") ""))) (is-checkbox (or (= input-type "checkbox") (= input-type "radio")))) (if is-checkbox (dom-set-prop el "checked" (deref sig)) (dom-set-prop el "value" (str (deref sig)))) (effect (fn () (if is-checkbox (dom-set-prop el "checked" (deref sig)) (let ((v (str (deref sig)))) (when (!= (dom-get-prop el "value") v) (dom-set-prop el "value" v)))))) (dom-on el (if is-checkbox "change" "input") (fn (e) (if is-checkbox (reset! sig (dom-get-prop el "checked")) (reset! sig (dom-get-prop el "value"))))))))
(define *use-cek-reactive* true)
+
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
-;; cek-reactive-text — create a text node bound via continuation capture
-(define cek-reactive-text :effects [render mutation]
- (fn (expr env)
- (let ((node (create-text-node ""))
- (update-fn (fn (val)
- (dom-set-text-content node (str val)))))
- (let ((initial (cek-run
- (make-cek-state expr env
- (list (make-reactive-reset-frame env update-fn true))))))
- (dom-set-text-content node (str initial))
- node))))
+(define cek-reactive-text :effects (render mutation) (fn (expr env) (let ((node (create-text-node "")) (update-fn (fn (val) (dom-set-text-content node (str val))))) (let ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) (dom-set-text-content node (str initial)) node))))
-;; cek-reactive-attr — bind an attribute via continuation capture
-(define cek-reactive-attr :effects [render mutation]
- (fn (el attr-name expr env)
- (let ((update-fn (fn (val)
- (cond
- (or (nil? val) (= val false)) (dom-remove-attr el attr-name)
- (= val true) (dom-set-attr el attr-name "")
- :else (dom-set-attr el attr-name (str val))))))
- ;; Mark for morph protection
- (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
- (updated (if (empty? existing) attr-name (str existing "," attr-name))))
- (dom-set-attr el "data-sx-reactive-attrs" updated))
- ;; Initial render via CEK with ReactiveResetFrame
- (let ((initial (cek-run
- (make-cek-state expr env
- (list (make-reactive-reset-frame env update-fn true))))))
- (cek-call update-fn (list initial))))))
+(define cek-reactive-attr :effects (render mutation) (fn (el attr-name expr env) (let ((update-fn (fn (val) (cond (or (nil? val) (= val false)) (dom-remove-attr el attr-name) (= val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str val)))))) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (updated (if (empty? existing) attr-name (str existing "," attr-name)))) (dom-set-attr el "data-sx-reactive-attrs" updated)) (let ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) (cek-call update-fn (list initial))))))
+(define render-dom-portal :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((selector (trampoline (eval-expr (first args) env))) (target (or (dom-query selector) (dom-ensure-element selector)))) (if (not target) (create-comment (str "portal: " selector " (not found)")) (let ((marker (create-comment (str "portal: " selector))) (frag (create-fragment))) (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) (rest args)) (let ((portal-nodes (dom-child-nodes frag))) (dom-append target frag) (register-in-scope (fn () (for-each (fn (n) (dom-remove n)) portal-nodes)))) marker)))))
-;; --------------------------------------------------------------------------
-;; render-dom-portal — render children into a remote target element
-;; --------------------------------------------------------------------------
-;;
-;; (portal "#modal-root" (div "content"))
-;;
-;; Renders children into the DOM node matched by the selector, rather than
-;; into the current position. Returns a comment marker at the original
-;; position. Registers a disposer to clean up portal content on island
-;; teardown.
-
-(define render-dom-portal :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((selector (trampoline (eval-expr (first args) env)))
- (target (or (dom-query selector)
- (dom-ensure-element selector))))
- (if (not target)
- (create-comment (str "portal: " selector " (not found)"))
- (let ((marker (create-comment (str "portal: " selector)))
- (frag (create-fragment)))
- ;; Render children into the fragment
- (for-each
- (fn (child) (dom-append frag (render-to-dom child env ns)))
- (rest args))
- ;; Track portal nodes for disposal
- (let ((portal-nodes (dom-child-nodes frag)))
- ;; Append into remote target
- (dom-append target frag)
- ;; Register disposer: remove portal content on island teardown
- (register-in-scope
- (fn ()
- (for-each (fn (n) (dom-remove n)) portal-nodes))))
- ;; Return marker at original position
- marker)))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-error-boundary — catch errors, render fallback UI
-;; --------------------------------------------------------------------------
-;;
-;; (error-boundary fallback-fn body...)
-;;
-;; Renders body children inside a try/catch. If any child throws during
-;; rendering, the fallback function is called with the error object, and
-;; its result is rendered instead. Effects within the boundary are disposed
-;; on error.
-;;
-;; The fallback function receives the error and a retry thunk:
-;; (fn (err retry) ...)
-;; Calling (retry) re-renders the body, replacing the fallback.
-
-(define render-dom-error-boundary :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((fallback-expr (first args))
- (body-exprs (rest args))
- (container (dom-create-element "div" nil))
- ;; retry-version: bump this signal to force re-render after fallback
- (retry-version (signal 0)))
- (dom-set-attr container "data-sx-boundary" "true")
-
- ;; The entire body is rendered inside ONE effect + try-catch.
- ;; Body renders WITHOUT island scope so that if/when/cond use static
- ;; paths — their signal reads become direct deref calls tracked by THIS
- ;; effect. Errors from signal changes throw synchronously within try-catch.
- ;; The error boundary's own effect handles all reactivity for its subtree.
- (effect (fn ()
- ;; Touch retry-version so the effect re-runs when retry is called
- (deref retry-version)
-
- ;; Clear container
- (dom-set-prop container "innerHTML" "")
-
- ;; Push nil island scope to suppress reactive rendering in body.
- ;; Pop in both success and error paths.
- (scope-push! "sx-island-scope" nil)
- (try-catch
- (fn ()
- ;; Body renders statically — signal reads tracked by THIS effect,
- ;; throws propagate to our try-catch.
- (let ((frag (create-fragment)))
- (for-each
- (fn (child)
- (dom-append frag (render-to-dom child env ns)))
- body-exprs)
- (dom-append container frag))
- (scope-pop! "sx-island-scope"))
- (fn (err)
- ;; Pop scope first, then render fallback
- (scope-pop! "sx-island-scope")
- (let ((fallback-fn (trampoline (eval-expr fallback-expr env)))
- (retry-fn (fn () (swap! retry-version (fn (n) (+ n 1))))))
- (let ((fallback-dom
- (if (lambda? fallback-fn)
- (render-lambda-dom fallback-fn (list err retry-fn) env ns)
- (render-to-dom (apply fallback-fn (list err retry-fn)) env ns))))
- (dom-append container fallback-dom)))))))
-
- container)))
-
-
-;; --------------------------------------------------------------------------
-;; 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
-;; (create-comment s) → Comment node
-;;
-;; Tree mutation:
-;; (dom-append parent child) → void (appendChild)
-;; (dom-set-attr el name val) → void (setAttribute)
-;; (dom-remove-attr el name) → void (removeAttribute)
-;; (dom-get-attr el name) → string or nil (getAttribute)
-;; (dom-set-text-content n s) → void (set textContent)
-;; (dom-remove node) → void (remove from parent)
-;; (dom-insert-after ref node) → void (insert node after ref)
-;; (dom-parent node) → parent Element or nil
-;; (dom-child-nodes frag) → list of child nodes
-;; (dom-remove-children-after m)→ void (remove all siblings after marker)
-;; (dom-set-data el key val) → void (store arbitrary data on element)
-;; (dom-get-data el key) → any (retrieve data stored on element)
-;;
-;; Property access (for input binding):
-;; (dom-set-prop el name val) → void (set JS property: el[name] = val)
-;; (dom-get-prop el name) → any (read JS property: el[name])
-;;
-;; Query (for portals):
-;; (dom-query selector) → Element or nil (document.querySelector)
-;;
-;; Event handling:
-;; (dom-listen el name handler) → remove-fn (addEventListener, returns remover)
-;; (dom-dispatch el name detail)→ boolean (dispatch CustomEvent, bubbles: true)
-;;
-;; 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?
-;;
-;; From eval.sx:
-;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond
-;; env-has?, env-get, env-set!, env-merge
-;; lambda?, component?, island?, macro?
-;; lambda-closure, lambda-params, lambda-body
-;; component-params, component-body, component-closure,
-;; component-has-children?, component-name
-;;
-;; From signals.sx:
-;; signal, deref, reset!, swap!, computed, effect, batch
-;; signal?, with-island-scope, register-in-scope
-;;
-;; Pure primitives used:
-;; keys, get, str
-;;
-;; Iteration:
-;; (for-each-indexed fn coll) → call fn(index, item) for each element
-;; --------------------------------------------------------------------------
+(define render-dom-error-boundary :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((fallback-expr (first args)) (body-exprs (rest args)) (container (dom-create-element "div" nil)) (retry-version (signal 0))) (dom-set-attr container "data-sx-boundary" "true") (effect (fn () (deref retry-version) (dom-set-prop container "innerHTML" "") (scope-push! "sx-island-scope" nil) (try-catch (fn () (let ((frag (create-fragment))) (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) body-exprs) (dom-append container frag)) (scope-pop! "sx-island-scope")) (fn (err) (scope-pop! "sx-island-scope") (let ((fallback-fn (trampoline (eval-expr fallback-expr env))) (retry-fn (fn () (swap! retry-version (fn (n) (+ n 1)))))) (let ((fallback-dom (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns)))) (dom-append container fallback-dom))))))) container)))
diff --git a/web/adapter-dom.sx b/web/adapter-dom.sx
index 2c23bae4..c2fa1d30 100644
--- a/web/adapter-dom.sx
+++ b/web/adapter-dom.sx
@@ -1,1375 +1,65 @@
-;; ==========================================================================
-;; 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")
-;; Check if we're inside an island scope.
-;; Uses scope-peek (mutable scope stack) rather than context (CEK continuation)
-;; because with-island-scope uses scope-push!, not provide.
-(define island-scope?
- (fn () (not (nil? (scope-peek "sx-island-scope")))))
+(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope")))))
+(define contains-deref? (fn (expr) (if (not (list? expr)) false (if (empty? expr) false (if (and (= (type-of (first expr)) "symbol") (= (symbol-name (first expr)) "deref")) true (some contains-deref? expr))))))
-;; --------------------------------------------------------------------------
-;; dom-on — dom-listen with post-render hooks
-;;
-;; Wraps dom-listen so that run-post-render-hooks fires after every SX
-;; event handler invocation. This is the SX-level hook integration;
-;; the native dom-listen primitive is a clean addEventListener wrapper.
-;; --------------------------------------------------------------------------
+(define dom-on :effects (io) (fn (el name handler) (dom-listen el name (if (lambda? handler) (if (= 0 (len (lambda-params handler))) (fn (_e) (trampoline (call-lambda handler (list))) (run-post-render-hooks)) (fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks))) handler))))
-(define dom-on :effects [io]
- (fn (el name handler)
- (dom-listen el name
- (if (lambda? handler)
- (if (= 0 (len (lambda-params handler)))
- (fn (_e) (trampoline (call-lambda handler (list))) (run-post-render-hooks))
- (fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks)))
- handler))))
+(define render-to-dom :effects (render) (fn (expr (env :as dict) (ns :as string)) (set-render-active! true) (case (type-of expr) "nil" (create-fragment) "boolean" (create-fragment) "raw-html" (dom-parse-html (raw-html-content expr)) "string" (create-text-node expr) "number" (create-text-node (str expr)) "symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns) "keyword" (create-text-node (keyword-name expr)) "dom-node" expr "spread" (do (when (not (island-scope?)) (scope-emit! "element-attrs" (spread-attrs expr))) expr) "dict" (if (has-key? expr "__host_handle") expr (create-fragment)) "list" (if (empty? expr) (create-fragment) (render-dom-list expr env ns)) :else (if (signal? expr) (if (island-scope?) (reactive-text expr) (create-text-node (str (deref expr)))) (create-text-node (str expr))))))
+(define render-dom-list :effects (render) (fn (expr (env :as dict) (ns :as string)) (let ((head (first expr))) (cond (= (type-of head) "symbol") (let ((name (symbol-name head)) (args (rest expr))) (cond (= name "raw!") (render-dom-raw args env) (= name "<>") (render-dom-fragment args env ns) (= name "lake") (render-dom-lake args env ns) (= name "marsh") (render-dom-marsh args env ns) (starts-with? name "html:") (render-dom-element (slice name 5) args env ns) (render-dom-form? name) (if (and (contains? HTML_TAGS name) (or (and (> (len args) 0) (= (type-of (first args)) "keyword")) ns)) (render-dom-element name args env ns) (dispatch-render-form name expr env ns)) (and (env-has? env name) (macro? (env-get env name))) (render-to-dom (expand-macro (env-get env name) args env) env ns) (contains? HTML_TAGS name) (render-dom-element name args env ns) (and (starts-with? name "~") (env-has? env name) (island? (env-get env name))) (if (scope-peek "sx-render-markers") (let ((island (env-get env name)) (marker (dom-create-element "span" nil))) (dom-set-attr marker "data-sx-island" (component-name island)) marker) (render-dom-island (env-get env name) args env ns)) (starts-with? name "~") (let ((comp (env-get env name))) (if (component? comp) (render-dom-component comp args env ns) (render-dom-unknown-component name))) (and (> (index-of name "-") 0) (> (len args) 0) (= (type-of (first args)) "keyword")) (render-dom-element name args env ns) ns (render-dom-element name args env ns) (and (= name "deref") (island-scope?)) (let ((sig-or-val (trampoline (eval-expr (first args) env)))) (if (signal? sig-or-val) (reactive-text sig-or-val) (create-text-node (str (deref sig-or-val))))) (and (island-scope?) (contains-deref? expr)) (reactive-text (computed (fn () (trampoline (eval-expr expr env))))) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))) (or (lambda? head) (= (type-of head) "list")) (render-to-dom (trampoline (eval-expr expr env)) env ns) :else (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) expr) frag)))))
-;; --------------------------------------------------------------------------
-;; render-to-dom — main entry point
-;; --------------------------------------------------------------------------
+(define render-dom-element :effects (render) (fn ((tag :as string) (args :as list) (env :as dict) (ns :as string)) (let ((new-ns (cond (= tag "svg") SVG_NS (= tag "math") MATH_NS :else ns)) (el (dom-create-element tag new-ns))) (scope-push! "element-attrs" nil) (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))) (let ((attr-name (keyword-name arg)) (attr-expr (nth args (inc (get state "i"))))) (cond (starts-with? attr-name "on-") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (callable? attr-val) (dom-on el (slice attr-name 3) attr-val))) (= attr-name "bind") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (when (signal? attr-val) (bind-input el attr-val))) (= attr-name "ref") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dict-set! attr-val "current" el)) (= attr-name "key") (let ((attr-val (trampoline (eval-expr attr-expr env)))) (dom-set-attr el "key" (str attr-val))) (island-scope?) (reactive-attr el attr-name (fn () (trampoline (eval-expr attr-expr env)))) :else (let ((attr-val (trampoline (eval-expr attr-expr env)))) (cond (or (nil? attr-val) (= attr-val false)) nil (contains? BOOLEAN_ATTRS attr-name) (when attr-val (dom-set-attr el attr-name "")) (= attr-val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str attr-val))))) (assoc state "skip" true "i" (inc (get state "i")))) (do (when (not (contains? VOID_ELEMENTS tag)) (let ((child (render-to-dom arg env new-ns))) (cond (and (spread? child) (island-scope?)) (reactive-spread el (fn () (render-to-dom arg env new-ns))) (spread? child) nil :else (dom-append el child)))) (assoc state "i" (inc (get state "i")))))))) (dict "i" 0 "skip" false) args) (for-each (fn (spread-dict) (for-each (fn ((key :as string)) (let ((val (dict-get spread-dict key))) (if (= key "class") (let ((existing (dom-get-attr el "class"))) (dom-set-attr el "class" (if (and existing (not (= existing ""))) (str existing " " val) val))) (if (= key "style") (let ((existing (dom-get-attr el "style"))) (dom-set-attr el "style" (if (and existing (not (= existing ""))) (str existing ";" val) val))) (dom-set-attr el key (str val)))))) (keys spread-dict))) (scope-emitted "element-attrs")) (scope-pop! "element-attrs") el)))
-(define render-to-dom :effects [render]
- (fn (expr (env :as dict) (ns :as string))
- (set-render-active! true)
- (case (type-of expr)
- ;; nil / boolean false / boolean true → empty fragment
- "nil" (create-fragment)
- "boolean" (create-fragment)
+(define render-dom-component :effects (render) (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string)) (let ((kwargs (dict)) (children (list))) (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))) (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) (let ((local (env-merge (component-closure comp) env))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params comp)) (when (component-has-children? comp) (let ((child-frag (create-fragment))) (for-each (fn (c) (let ((result (render-to-dom c env ns))) (when (not (spread? result)) (dom-append child-frag result)))) children) (env-bind! local "children" child-frag))) (render-to-dom (component-body comp) local ns)))))
- ;; Pre-rendered raw HTML → parse into fragment
- "raw-html" (dom-parse-html (raw-html-content expr))
+(define render-dom-fragment :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((frag (create-fragment))) (for-each (fn (x) (let ((result (render-to-dom x env ns))) (when (not (spread? result)) (dom-append frag result)))) args) frag)))
- ;; String → text node
- "string" (create-text-node expr)
+(define render-dom-raw :effects (render) (fn ((args :as list) (env :as dict)) (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)))
- ;; Number → text node
- "number" (create-text-node (str expr))
+(define render-dom-unknown-component :effects (render) (fn ((name :as string)) (error (str "Unknown component: " name))))
- ;; Symbol → evaluate then render
- "symbol" (render-to-dom (trampoline (eval-expr expr env)) env ns)
+(define RENDER_DOM_FORMS (list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do" "define" "defcomp" "defisland" "defmacro" "defstyle" "map" "map-indexed" "filter" "for-each" "portal" "error-boundary" "scope" "provide"))
- ;; Keyword → text
- "keyword" (create-text-node (keyword-name expr))
+(define render-dom-form? :effects () (fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
- ;; Pre-rendered DOM node → pass through
- "dom-node" expr
+(define dispatch-render-form :effects (render) (fn ((name :as string) expr (env :as dict) (ns :as string)) (cond (= name "if") (if (island-scope?) (let ((marker (create-comment "r-if")) (current-nodes (list)) (initial-result nil)) (effect (fn () (let ((result (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)))))) (if (dom-parent marker) (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)) (set! initial-result result))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (set! current-nodes (if (dom-is-fragment? initial-result) (dom-child-nodes initial-result) (list initial-result))) (dom-append frag initial-result)) frag))) (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))))) (= name "when") (if (island-scope?) (let ((marker (create-comment "r-when")) (current-nodes (list)) (initial-result nil)) (effect (fn () (if (dom-parent marker) (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag)))) (when (trampoline (eval-expr (nth expr 1) env)) (let ((frag (create-fragment))) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 2 (len expr))) (set! current-nodes (dom-child-nodes frag)) (set! initial-result frag)))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) (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))) (= name "cond") (if (island-scope?) (let ((marker (create-comment "r-cond")) (current-nodes (list)) (initial-result nil)) (effect (fn () (let ((branch (eval-cond (rest expr) env))) (if (dom-parent marker) (do (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (dom-insert-after marker result)))) (when branch (let ((result (render-to-dom branch env ns))) (set! current-nodes (if (dom-is-fragment? result) (dom-child-nodes result) (list result))) (set! initial-result result))))))) (if (spread? initial-result) initial-result (let ((frag (create-fragment))) (dom-append frag marker) (when initial-result (dom-append frag initial-result)) frag))) (let ((branch (eval-cond (rest expr) env))) (if branch (render-to-dom branch env ns) (create-fragment)))) (= name "case") (render-to-dom (trampoline (eval-expr expr env)) env ns) (or (= name "let") (= name "let*")) (let ((local (process-bindings (nth expr 1) env))) (if (= (len expr) 3) (render-to-dom (nth expr 2) local ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) local ns))) (when (not (spread? result)) (dom-append frag result)))) (range 2 (len expr))) frag))) (= name "letrec") (let ((bindings (nth expr 1)) (body (slice expr 2)) (local (env-extend env))) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-bind! local pname nil))) bindings) (for-each (fn (pair) (let ((pname (if (= (type-of (first pair)) "symbol") (symbol-name (first pair)) (str (first pair))))) (env-set! local pname (trampoline (eval-expr (nth pair 1) local))))) bindings) (when (> (len body) 1) (for-each (fn (e) (trampoline (eval-expr e local))) (init body))) (render-to-dom (last body) local ns)) (or (= name "begin") (= name "do")) (if (= (len expr) 2) (render-to-dom (nth expr 1) env ns) (let ((frag (create-fragment))) (for-each (fn (i) (let ((result (render-to-dom (nth expr i) env ns))) (when (not (spread? result)) (dom-append frag result)))) (range 1 (len expr))) frag)) (definition-form? name) (do (trampoline (eval-expr expr env)) (create-fragment)) (= name "map") (let ((coll-expr (nth expr 2))) (if (and (island-scope?) (= (type-of coll-expr) "list") (> (len coll-expr) 1) (= (type-of (first coll-expr)) "symbol") (= (symbol-name (first coll-expr)) "deref")) (let ((f (trampoline (eval-expr (nth expr 1) env))) (sig (trampoline (eval-expr (nth coll-expr 1) env)))) (if (signal? sig) (reactive-list f sig env ns) (let ((coll (deref sig)) (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))) (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))) (= 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) (= name "filter") (render-to-dom (trampoline (eval-expr expr env)) env ns) (= name "portal") (render-dom-portal (rest expr) env ns) (= name "error-boundary") (render-dom-error-boundary (rest expr) env ns) (= 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) (= name "scope") (let ((scope-name (trampoline (eval-expr (nth expr 1) env))) (rest-args (slice expr 2)) (scope-val nil) (body-exprs nil) (frag (create-fragment))) (if (and (>= (len rest-args) 2) (= (type-of (first rest-args)) "keyword") (= (keyword-name (first rest-args)) "value")) (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env))) (set! body-exprs (slice rest-args 2))) (set! body-exprs rest-args)) (scope-push! scope-name scope-val) (for-each (fn (e) (dom-append frag (render-to-dom e env ns))) body-exprs) (scope-pop! scope-name) frag) (= name "provide") (let ((prov-name (trampoline (eval-expr (nth expr 1) env))) (prov-val (trampoline (eval-expr (nth expr 2) env))) (frag (create-fragment))) (scope-push! prov-name prov-val) (for-each (fn (i) (dom-append frag (render-to-dom (nth expr i) env ns))) (range 3 (len expr))) (scope-pop! prov-name) frag) :else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
- ;; Spread → emit attrs to nearest element provider, pass through for reactive-spread
- ;; Inside islands, reactive-spread handles attr application directly —
- ;; skip scope emission to avoid double/triple application.
- "spread" (do (when (not (island-scope?))
- (scope-emit! "element-attrs" (spread-attrs expr)))
- expr)
+(define render-lambda-dom :effects (render) (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string)) (let ((local (env-merge (lambda-closure f) env))) (for-each-indexed (fn (i p) (env-bind! local p (nth args i))) (lambda-params f)) (render-to-dom (lambda-body f) local ns))))
- ;; Dict → check for host DOM node, else empty fragment
- "dict" (if (has-key? expr "__host_handle")
- expr ;; Host DOM node (text node, element, etc.) — pass through
- (create-fragment))
+(define render-dom-island :effects (render mutation) (fn ((island :as island) (args :as list) (env :as dict) (ns :as string)) (let ((kwargs (dict)) (children (list))) (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))) (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) (let ((local (env-merge (component-closure island) env)) (island-name (component-name island))) (for-each (fn (p) (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil))) (component-params island)) (when (component-has-children? island) (let ((child-frag (create-fragment))) (for-each (fn (c) (dom-append child-frag (render-to-dom c env ns))) children) (env-bind! local "children" child-frag))) (let ((container (dom-create-element "span" nil)) (disposers (list))) (dom-set-attr container "data-sx-island" island-name) (mark-processed! container "island-hydrated") (let ((body-dom (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body island) local ns))))) (dom-append container body-dom) (dom-set-data container "sx-disposers" disposers) container))))))
- ;; List → dispatch
- "list"
- (if (empty? expr)
- (create-fragment)
- (render-dom-list expr env ns))
+(define render-dom-lake :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((lake-id nil) (lake-tag "div") (children (list))) (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))) (let ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! lake-id kval) (= kname "tag") (set! lake-tag kval)) (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) (let ((el (dom-create-element lake-tag nil))) (dom-set-attr el "data-sx-lake" (or lake-id "")) (for-each (fn (c) (dom-append el (render-to-dom c env ns))) children) el))))
- ;; Signal → reactive text in island scope, deref outside
- :else
- (if (signal? expr)
- (if (island-scope?)
- (reactive-text expr)
- (create-text-node (str (deref expr))))
- (create-text-node (str expr))))))
+(define render-dom-marsh :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((marsh-id nil) (marsh-tag "div") (marsh-transform nil) (children (list))) (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))) (let ((kname (keyword-name arg)) (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env)))) (cond (= kname "id") (set! marsh-id kval) (= kname "tag") (set! marsh-tag kval) (= kname "transform") (set! marsh-transform kval)) (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) (let ((el (dom-create-element marsh-tag nil))) (dom-set-attr el "data-sx-marsh" (or marsh-id "")) (when marsh-transform (dom-set-data el "sx-marsh-transform" marsh-transform)) (dom-set-data el "sx-marsh-env" env) (for-each (fn (c) (dom-append el (render-to-dom c env ns))) children) el))))
+(define reactive-text :effects (render mutation) (fn (sig) (let ((node (create-text-node (str (deref sig))))) (effect (fn () (dom-set-text-content node (str (deref sig))))) node)))
-;; --------------------------------------------------------------------------
-;; render-dom-list — dispatch on list head
-;; --------------------------------------------------------------------------
+(define reactive-attr :effects (render mutation) (fn (el (attr-name :as string) (compute-fn :as lambda)) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (updated (if (empty? existing) attr-name (str existing "," attr-name)))) (dom-set-attr el "data-sx-reactive-attrs" updated)) (effect (fn () (let ((raw (compute-fn))) (let ((val (if (signal? raw) (deref raw) raw))) (cond (or (nil? val) (= val false)) (dom-remove-attr el attr-name) (= val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str val)))))))))
-(define render-dom-list :effects [render]
- (fn (expr (env :as dict) (ns :as string))
- (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)
+(define reactive-spread :effects (render mutation) (fn (el (render-fn :as lambda)) (let ((prev-classes (list)) (prev-extra-keys (list))) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))) (dom-set-attr el "data-sx-reactive-attrs" (if (empty? existing) "_spread" (str existing ",_spread")))) (effect (fn () (when (not (empty? prev-classes)) (let ((current (or (dom-get-attr el "class") "")) (tokens (filter (fn (c) (not (= c ""))) (split current " "))) (kept (filter (fn (c) (not (some (fn (pc) (= pc c)) prev-classes))) tokens))) (if (empty? kept) (dom-remove-attr el "class") (dom-set-attr el "class" (join " " kept))))) (for-each (fn (k) (dom-remove-attr el k)) prev-extra-keys) (let ((result (render-fn))) (if (spread? result) (let ((attrs (spread-attrs result)) (cls-str (or (dict-get attrs "class") "")) (new-classes (filter (fn (c) (not (= c ""))) (split cls-str " "))) (extra-keys (filter (fn (k) (not (= k "class"))) (keys attrs)))) (set! prev-classes new-classes) (set! prev-extra-keys extra-keys) (when (not (empty? new-classes)) (let ((current (or (dom-get-attr el "class") ""))) (dom-set-attr el "class" (if (and current (not (= current ""))) (str current " " cls-str) cls-str)))) (for-each (fn (k) (dom-set-attr el k (str (dict-get attrs k)))) extra-keys) (run-post-render-hooks)) (do (set! prev-classes (list)) (set! prev-extra-keys (list))))))))))
- ;; <> → fragment
- (= name "<>")
- (render-dom-fragment args env ns)
+(define reactive-fragment :effects (render mutation) (fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string)) (let ((marker (create-comment "island-fragment")) (current-nodes (list))) (effect (fn () (for-each (fn (n) (dom-remove n)) current-nodes) (set! current-nodes (list)) (when (test-fn) (let ((frag (render-fn))) (set! current-nodes (dom-child-nodes frag)) (dom-insert-after marker frag))))) marker)))
- ;; lake — server-morphable slot within an island
- (= name "lake")
- (render-dom-lake args env ns)
+(define render-list-item :effects (render) (fn ((map-fn :as lambda) item (env :as dict) (ns :as string)) (if (lambda? map-fn) (render-lambda-dom map-fn (list item) env ns) (render-to-dom (apply map-fn (list item)) env ns))))
- ;; marsh — reactive server-morphable slot within an island
- (= name "marsh")
- (render-dom-marsh args env ns)
+(define extract-key :effects (render) (fn (node (index :as number)) (let ((k (dom-get-attr node "key"))) (if k (do (dom-remove-attr node "key") k) (let ((dk (dom-get-data node "key"))) (if dk (str dk) (str "__idx_" index)))))))
- ;; html: prefix → force element rendering
- (starts-with? name "html:")
- (render-dom-element (slice name 5) args env ns)
+(define reactive-list :effects (render mutation) (fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string)) (let ((container (create-fragment)) (marker (create-comment "island-list")) (key-map (dict)) (key-order (list))) (dom-append container marker) (effect (fn () (let ((items (deref items-sig))) (if (dom-parent marker) (let ((new-map (dict)) (new-keys (list)) (has-keys false)) (for-each-indexed (fn (idx item) (let ((rendered (render-list-item map-fn item env ns)) (key (extract-key rendered idx))) (when (and (not has-keys) (not (starts-with? key "__idx_"))) (set! has-keys true)) (if (dict-has? key-map key) (dict-set! new-map key (dict-get key-map key)) (dict-set! new-map key rendered)) (append! new-keys key))) items) (if (not has-keys) (do (dom-remove-children-after marker) (let ((frag (create-fragment))) (for-each (fn (k) (dom-append frag (dict-get new-map k))) new-keys) (dom-insert-after marker frag))) (do (for-each (fn (old-key) (when (not (dict-has? new-map old-key)) (dom-remove (dict-get key-map old-key)))) key-order) (let ((cursor marker)) (for-each (fn (k) (let ((node (dict-get new-map k)) (next (dom-next-sibling cursor))) (when (not (identical? node next)) (dom-insert-after cursor node)) (set! cursor node))) new-keys)))) (set! key-map new-map) (set! key-order new-keys)) (for-each-indexed (fn (idx item) (let ((rendered (render-list-item map-fn item env ns)) (key (extract-key rendered idx))) (dict-set! key-map key rendered) (append! key-order key) (dom-append container rendered))) items))))) container)))
- ;; 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)
-
- ;; Island (~name) — reactive component
- (and (starts-with? name "~")
- (env-has? env name)
- (island? (env-get env name)))
- ;; In marker mode (sx-render for swap), create empty marker span
- ;; that post-swap will hydrate. Otherwise, full render.
- (if (scope-peek "sx-render-markers")
- (let ((island (env-get env name))
- (marker (dom-create-element "span" nil)))
- (dom-set-attr marker "data-sx-island" (component-name island))
- marker)
- (render-dom-island (env-get env 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)
-
- ;; deref in island scope → reactive text node
- (and (= name "deref") (island-scope?))
- (let ((sig-or-val (trampoline (eval-expr (first args) env))))
- (if (signal? sig-or-val)
- (reactive-text sig-or-val)
- (create-text-node (str (deref sig-or-val)))))
-
- ;; 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)
- (let ((result (render-to-dom x env ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- expr)
- frag)))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-element — create a DOM element with attrs and children
-;; --------------------------------------------------------------------------
-
-(define render-dom-element :effects [render]
- (fn ((tag :as string) (args :as list) (env :as dict) (ns :as string))
- ;; 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)))
-
- ;; Provide scope for spread emit! — deeply nested spreads emit here
- (scope-push! "element-attrs" 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-expr (nth args (inc (get state "i")))))
- (cond
- ;; Event handler: evaluate eagerly, bind listener
- (starts-with? attr-name "on-")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (when (callable? attr-val)
- (dom-on el (slice attr-name 3) attr-val)))
- ;; Two-way input binding: :bind signal
- (= attr-name "bind")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (when (signal? attr-val) (bind-input el attr-val)))
- ;; ref: set ref.current to this element
- (= attr-name "ref")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (dict-set! attr-val "current" el))
- ;; key: reconciliation hint, evaluate eagerly (not reactive)
- (= attr-name "key")
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (dom-set-attr el "key" (str attr-val)))
- ;; Inside island scope: reactive attribute binding.
- ;; The effect tracks signal deps automatically — if none
- ;; are deref'd, it fires once and never again (safe).
- (island-scope?)
- (reactive-attr el attr-name
- (fn () (trampoline (eval-expr attr-expr env))))
- ;; Static attribute (outside islands)
- :else
- (let ((attr-val (trampoline (eval-expr attr-expr env))))
- (cond
- (or (nil? attr-val) (= attr-val false)) nil
- (contains? BOOLEAN_ATTRS attr-name)
- (when attr-val (dom-set-attr el attr-name ""))
- (= attr-val true)
- (dom-set-attr el attr-name "")
- :else
- (dom-set-attr el attr-name (str attr-val)))))
- (assoc state "skip" true "i" (inc (get state "i"))))
-
- ;; Positional arg → child (or spread → merge attrs onto element)
- (do
- (when (not (contains? VOID_ELEMENTS tag))
- (let ((child (render-to-dom arg env new-ns)))
- (cond
- ;; Reactive spread: track signal deps, update attrs on change
- (and (spread? child) (island-scope?))
- (reactive-spread el (fn () (render-to-dom arg env new-ns)))
- ;; Static spread: already emitted via provide, skip
- (spread? child) nil
- ;; Normal child: append to element
- :else
- (dom-append el child))))
- (assoc state "i" (inc (get state "i"))))))))
- (dict "i" 0 "skip" false)
- args)
-
- ;; Collect emitted spread attrs and merge onto DOM element
- (for-each
- (fn (spread-dict)
- (for-each
- (fn ((key :as string))
- (let ((val (dict-get spread-dict key)))
- (if (= key "class")
- (let ((existing (dom-get-attr el "class")))
- (dom-set-attr el "class"
- (if (and existing (not (= existing "")))
- (str existing " " val)
- val)))
- (if (= key "style")
- (let ((existing (dom-get-attr el "style")))
- (dom-set-attr el "style"
- (if (and existing (not (= existing "")))
- (str existing ";" val)
- val)))
- (dom-set-attr el key (str val))))))
- (keys spread-dict)))
- (scope-emitted "element-attrs"))
- (scope-pop! "element-attrs")
-
- el)))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-component — expand and render a component
-;; --------------------------------------------------------------------------
-
-(define render-dom-component :effects [render]
- (fn ((comp :as component) (args :as list) (env :as dict) (ns :as string))
- ;; 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-bind! 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
- ;; Spread values are filtered out (no parent element to merge onto)
- (when (component-has-children? comp)
- (let ((child-frag (create-fragment)))
- (for-each
- (fn (c)
- (let ((result (render-to-dom c env ns)))
- (when (not (spread? result))
- (dom-append child-frag result))))
- children)
- (env-bind! local "children" child-frag)))
-
- (render-to-dom (component-body comp) local ns)))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-fragment — render children into a DocumentFragment
-;; --------------------------------------------------------------------------
-
-(define render-dom-fragment :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((frag (create-fragment)))
- (for-each
- (fn (x)
- (let ((result (render-to-dom x env ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- args)
- frag)))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-raw — insert unescaped content
-;; --------------------------------------------------------------------------
-
-(define render-dom-raw :effects [render]
- (fn ((args :as list) (env :as dict))
- (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 :effects [render]
- (fn ((name :as string))
- (error (str "Unknown component: " name))))
-
-
-;; --------------------------------------------------------------------------
-;; 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*" "letrec" "begin" "do"
- "define" "defcomp" "defisland" "defmacro" "defstyle"
- "map" "map-indexed" "filter" "for-each" "portal"
- "error-boundary" "scope" "provide"))
-
-(define render-dom-form? :effects []
- (fn ((name :as string))
- (contains? RENDER_DOM_FORMS name)))
-
-(define dispatch-render-form :effects [render]
- (fn ((name :as string) expr (env :as dict) (ns :as string))
- (cond
- ;; if — reactive inside islands (re-renders when signal deps change)
- (= name "if")
- (if (island-scope?)
- (let ((marker (create-comment "r-if"))
- (current-nodes (list))
- (initial-result nil))
- ;; Effect runs synchronously on first call, tracking signal deps.
- ;; On first run, store result in initial-result (marker has no parent yet).
- ;; On subsequent runs, swap DOM nodes after marker.
- (effect (fn ()
- (let ((result (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))))))
- (if (dom-parent marker)
- ;; Marker is in DOM — swap nodes
- (do
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes
- (if (dom-is-fragment? result)
- (dom-child-nodes result)
- (list result)))
- (dom-insert-after marker result))
- ;; Marker not yet in DOM (first run) — just save result
- (set! initial-result result)))))
- ;; Spread pass-through: spreads aren't DOM nodes, can't live
- ;; in fragments. Return directly so parent element merges attrs.
- (if (spread? initial-result)
- initial-result
- (let ((frag (create-fragment)))
- (dom-append frag marker)
- (when initial-result
- (set! current-nodes
- (if (dom-is-fragment? initial-result)
- (dom-child-nodes initial-result)
- (list initial-result)))
- (dom-append frag initial-result))
- frag)))
- ;; Static 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 — reactive inside islands
- (= name "when")
- (if (island-scope?)
- (let ((marker (create-comment "r-when"))
- (current-nodes (list))
- (initial-result nil))
- (effect (fn ()
- (if (dom-parent marker)
- ;; In DOM — swap nodes
- (do
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes (list))
- (when (trampoline (eval-expr (nth expr 1) env))
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (dom-append frag (render-to-dom (nth expr i) env ns)))
- (range 2 (len expr)))
- (set! current-nodes (dom-child-nodes frag))
- (dom-insert-after marker frag))))
- ;; First run — save result for fragment
- (when (trampoline (eval-expr (nth expr 1) env))
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (dom-append frag (render-to-dom (nth expr i) env ns)))
- (range 2 (len expr)))
- (set! current-nodes (dom-child-nodes frag))
- (set! initial-result frag))))))
- ;; Spread pass-through
- (if (spread? initial-result)
- initial-result
- (let ((frag (create-fragment)))
- (dom-append frag marker)
- (when initial-result (dom-append frag initial-result))
- frag)))
- ;; Static 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 — reactive inside islands
- (= name "cond")
- (if (island-scope?)
- (let ((marker (create-comment "r-cond"))
- (current-nodes (list))
- (initial-result nil))
- (effect (fn ()
- (let ((branch (eval-cond (rest expr) env)))
- (if (dom-parent marker)
- ;; In DOM — swap nodes
- (do
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes (list))
- (when branch
- (let ((result (render-to-dom branch env ns)))
- (set! current-nodes
- (if (dom-is-fragment? result)
- (dom-child-nodes result)
- (list result)))
- (dom-insert-after marker result))))
- ;; First run — save result for fragment
- (when branch
- (let ((result (render-to-dom branch env ns)))
- (set! current-nodes
- (if (dom-is-fragment? result)
- (dom-child-nodes result)
- (list result)))
- (set! initial-result result)))))))
- ;; Spread pass-through
- (if (spread? initial-result)
- initial-result
- (let ((frag (create-fragment)))
- (dom-append frag marker)
- (when initial-result (dom-append frag initial-result))
- frag)))
- ;; Static 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* — single body: pass through (spread propagates). Multi: fragment.
- (or (= name "let") (= name "let*"))
- (let ((local (process-bindings (nth expr 1) env)))
- (if (= (len expr) 3)
- (render-to-dom (nth expr 2) local ns)
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (let ((result (render-to-dom (nth expr i) local ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- (range 2 (len expr)))
- frag)))
-
- ;; letrec — pre-bind all names (nil), evaluate values, render body.
- (= name "letrec")
- (let ((bindings (nth expr 1))
- (body (slice expr 2))
- (local (env-extend env)))
- ;; Phase 1: pre-bind all names to nil
- (for-each (fn (pair)
- (let ((pname (if (= (type-of (first pair)) "symbol")
- (symbol-name (first pair))
- (str (first pair)))))
- (env-bind! local pname nil)))
- bindings)
- ;; Phase 2: evaluate values (all names in scope for mutual recursion)
- (for-each (fn (pair)
- (let ((pname (if (= (type-of (first pair)) "symbol")
- (symbol-name (first pair))
- (str (first pair)))))
- (env-set! local pname (trampoline (eval-expr (nth pair 1) local)))))
- bindings)
- ;; Phase 3: eval non-last body exprs for side effects, render last
- (when (> (len body) 1)
- (for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
- (render-to-dom (last body) local ns))
-
- ;; begin / do — single body: pass through. Multi: fragment.
- (or (= name "begin") (= name "do"))
- (if (= (len expr) 2)
- (render-to-dom (nth expr 1) env ns)
- (let ((frag (create-fragment)))
- (for-each
- (fn (i)
- (let ((result (render-to-dom (nth expr i) env ns)))
- (when (not (spread? result))
- (dom-append frag result))))
- (range 1 (len expr)))
- frag))
-
- ;; Definition forms — eval for side effects
- (definition-form? name)
- (do (trampoline (eval-expr expr env)) (create-fragment))
-
- ;; map — reactive-list when mapping over a signal inside an island
- (= name "map")
- (let ((coll-expr (nth expr 2)))
- (if (and (island-scope?)
- (= (type-of coll-expr) "list")
- (> (len coll-expr) 1)
- (= (type-of (first coll-expr)) "symbol")
- (= (symbol-name (first coll-expr)) "deref"))
- ;; Reactive path: pass signal to reactive-list
- (let ((f (trampoline (eval-expr (nth expr 1) env)))
- (sig (trampoline (eval-expr (nth coll-expr 1) env))))
- (if (signal? sig)
- (reactive-list f sig env ns)
- ;; deref on non-signal: fall through to static
- (let ((coll (deref sig))
- (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)))
- ;; Static path: no island scope or no deref
- (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)
-
- ;; portal — render children into a remote target element
- (= name "portal")
- (render-dom-portal (rest expr) env ns)
-
- ;; error-boundary — catch errors, render fallback
- (= name "error-boundary")
- (render-dom-error-boundary (rest expr) 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)
-
- ;; scope — unified render-time dynamic scope
- (= name "scope")
- (let ((scope-name (trampoline (eval-expr (nth expr 1) env)))
- (rest-args (slice expr 2))
- (scope-val nil)
- (body-exprs nil)
- (frag (create-fragment)))
- ;; Check for :value keyword
- (if (and (>= (len rest-args) 2)
- (= (type-of (first rest-args)) "keyword")
- (= (keyword-name (first rest-args)) "value"))
- (do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env)))
- (set! body-exprs (slice rest-args 2)))
- (set! body-exprs rest-args))
- (scope-push! scope-name scope-val)
- (for-each
- (fn (e)
- (dom-append frag (render-to-dom e env ns)))
- body-exprs)
- (scope-pop! scope-name)
- frag)
-
- ;; provide — sugar for scope with value
- (= name "provide")
- (let ((prov-name (trampoline (eval-expr (nth expr 1) env)))
- (prov-val (trampoline (eval-expr (nth expr 2) env)))
- (frag (create-fragment)))
- (scope-push! prov-name prov-val)
- (for-each
- (fn (i)
- (dom-append frag (render-to-dom (nth expr i) env ns)))
- (range 3 (len expr)))
- (scope-pop! prov-name)
- 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 :effects [render]
- (fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string))
- ;; Bind lambda params and render body as DOM
- (let ((local (env-merge (lambda-closure f) env)))
- (for-each-indexed
- (fn (i p)
- (env-bind! local p (nth args i)))
- (lambda-params f))
- (render-to-dom (lambda-body f) local ns))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-island — render a reactive island
-;; --------------------------------------------------------------------------
-;;
-;; Islands render like components but wrapped in a reactive context.
-;; The island container element gets data-sx-island and data-sx-state
-;; attributes for identification and hydration.
-;;
-;; Inside the island body, deref calls create reactive DOM subscriptions:
-;; - Text bindings: (deref sig) in text position → reactive text node
-;; - Attribute bindings: (deref sig) in attr → reactive attribute
-;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide
-
-(define render-dom-island :effects [render mutation]
- (fn ((island :as island) (args :as list) (env :as dict) (ns :as string))
- ;; Parse kwargs and children (same as component)
- (let ((kwargs (dict))
- (children (list)))
- (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)))
- (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 island env: closure + caller env + params
- (let ((local (env-merge (component-closure island) env))
- (island-name (component-name island)))
-
- ;; Bind params from kwargs
- (for-each
- (fn (p)
- (env-bind! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
- (component-params island))
-
- ;; If island accepts children, pre-render them to a fragment
- (when (component-has-children? island)
- (let ((child-frag (create-fragment)))
- (for-each
- (fn (c) (dom-append child-frag (render-to-dom c env ns)))
- children)
- (env-bind! local "children" child-frag)))
-
- ;; Create the island container element
- (let ((container (dom-create-element "span" nil))
- (disposers (list)))
-
- ;; Mark as island + already hydrated (so boot.sx skips it)
- (dom-set-attr container "data-sx-island" island-name)
- (mark-processed! container "island-hydrated")
-
- ;; Render island body inside a scope that tracks disposers
- (let ((body-dom
- (with-island-scope
- (fn (disposable) (append! disposers disposable))
- (fn () (render-to-dom (component-body island) local ns)))))
- (dom-append container body-dom)
-
- ;; Store disposers on the container for cleanup
- (dom-set-data container "sx-disposers" disposers)
-
- container))))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-lake — server-morphable slot within an island
-;; --------------------------------------------------------------------------
-;;
-;; (lake :id "name" children...)
-;;
-;; Renders as children
.
-;; During morph, the server can replace lake content while the surrounding
-;; reactive island DOM is preserved. This is the "water around the rocks" —
-;; server substance flowing through client territory.
-;;
-;; Supports :tag keyword to change wrapper element (default "div").
-
-(define render-dom-lake :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((lake-id nil)
- (lake-tag "div")
- (children (list)))
- (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)))
- (let ((kname (keyword-name arg))
- (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
- (cond
- (= kname "id") (set! lake-id kval)
- (= kname "tag") (set! lake-tag kval))
- (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)
- (let ((el (dom-create-element lake-tag nil)))
- (dom-set-attr el "data-sx-lake" (or lake-id ""))
- (for-each
- (fn (c) (dom-append el (render-to-dom c env ns)))
- children)
- el))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-marsh — reactive server-morphable slot within an island
-;; --------------------------------------------------------------------------
-;;
-;; (marsh :id "name" :tag "div" :transform fn children...)
-;;
-;; Like a lake but reactive: during morph, new content is parsed as SX and
-;; re-evaluated in the island's signal scope. The :transform function (if
-;; present) reshapes server content before evaluation.
-;;
-;; Renders as children
.
-;; Stores the island env and transform on the element for morph retrieval.
-
-(define render-dom-marsh :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((marsh-id nil)
- (marsh-tag "div")
- (marsh-transform nil)
- (children (list)))
- (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)))
- (let ((kname (keyword-name arg))
- (kval (trampoline (eval-expr (nth args (inc (get state "i"))) env))))
- (cond
- (= kname "id") (set! marsh-id kval)
- (= kname "tag") (set! marsh-tag kval)
- (= kname "transform") (set! marsh-transform kval))
- (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)
- (let ((el (dom-create-element marsh-tag nil)))
- (dom-set-attr el "data-sx-marsh" (or marsh-id ""))
- ;; Store transform function and island env for morph retrieval
- (when marsh-transform
- (dom-set-data el "sx-marsh-transform" marsh-transform))
- (dom-set-data el "sx-marsh-env" env)
- (for-each
- (fn (c) (dom-append el (render-to-dom c env ns)))
- children)
- el))))
-
-
-;; --------------------------------------------------------------------------
-;; Reactive DOM rendering helpers
-;; --------------------------------------------------------------------------
-;;
-;; These functions create reactive bindings between signals and DOM nodes.
-;; They are called by the platform's renderDOM when it detects deref
-;; calls inside an island context.
-
-;; reactive-text — create a text node bound to a signal
-;; Used when (deref sig) appears in a text position inside an island.
-(define reactive-text :effects [render mutation]
- (fn (sig)
- (let ((node (create-text-node (str (deref sig)))))
- (effect (fn ()
- (dom-set-text-content node (str (deref sig)))))
- node)))
-
-;; reactive-attr — bind an element attribute to a signal expression
-;; Used when an attribute value contains (deref sig) inside an island.
-;; Marks the attribute name on the element via data-sx-reactive-attrs so
-;; the morph algorithm knows not to overwrite it with server content.
-(define reactive-attr :effects [render mutation]
- (fn (el (attr-name :as string) (compute-fn :as lambda))
- ;; Mark this attribute as reactively managed
- (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
- (updated (if (empty? existing) attr-name (str existing "," attr-name))))
- (dom-set-attr el "data-sx-reactive-attrs" updated))
- (effect (fn ()
- (let ((raw (compute-fn)))
- ;; If compute-fn returned a signal (e.g. from computed), deref it
- ;; to get the actual value and track the dependency
- (let ((val (if (signal? raw) (deref raw) raw)))
- (cond
- (or (nil? val) (= val false))
- (dom-remove-attr el attr-name)
- (= val true)
- (dom-set-attr el attr-name "")
- :else
- (dom-set-attr el attr-name (str val)))))))))
-
-;; reactive-spread — reactively bind spread attrs to parent element.
-;; Used when a child of an element produces a spread inside an island.
-;; Tracks signal deps in the spread expression. When signals change:
-;; old classes are removed, new ones applied. Non-class attrs (data-tw etc.)
-;; are overwritten. Flushes newly collected CSS rules to live stylesheet.
-;;
-;; Multiple reactive spreads on the same element are safe — each tracks
-;; its own class contribution and only removes/adds its own tokens.
-(define reactive-spread :effects [render mutation]
- (fn (el (render-fn :as lambda))
- (let ((prev-classes (list))
- (prev-extra-keys (list)))
- ;; Mark for morph protection
- (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")))
- (dom-set-attr el "data-sx-reactive-attrs"
- (if (empty? existing) "_spread" (str existing ",_spread"))))
- (effect (fn ()
- ;; 1. Remove previously applied classes from element's class list
- (when (not (empty? prev-classes))
- (let ((current (or (dom-get-attr el "class") ""))
- (tokens (filter (fn (c) (not (= c ""))) (split current " ")))
- (kept (filter (fn (c)
- (not (some (fn (pc) (= pc c)) prev-classes)))
- tokens)))
- (if (empty? kept)
- (dom-remove-attr el "class")
- (dom-set-attr el "class" (join " " kept)))))
- ;; 2. Remove previously applied extra attrs
- (for-each (fn (k) (dom-remove-attr el k)) prev-extra-keys)
- ;; 3. Re-evaluate the spread expression (tracks signal deps)
- (let ((result (render-fn)))
- (if (spread? result)
- (let ((attrs (spread-attrs result))
- (cls-str (or (dict-get attrs "class") ""))
- (new-classes (filter (fn (c) (not (= c "")))
- (split cls-str " ")))
- (extra-keys (filter (fn (k) (not (= k "class")))
- (keys attrs))))
- (set! prev-classes new-classes)
- (set! prev-extra-keys extra-keys)
- ;; Append new classes to element
- (when (not (empty? new-classes))
- (let ((current (or (dom-get-attr el "class") "")))
- (dom-set-attr el "class"
- (if (and current (not (= current "")))
- (str current " " cls-str)
- cls-str))))
- ;; Set extra attrs (data-tw, etc.) — simple overwrite
- (for-each (fn (k)
- (dom-set-attr el k (str (dict-get attrs k))))
- extra-keys)
- ;; Flush any newly collected CSS rules to live stylesheet
- (run-post-render-hooks))
- ;; No longer a spread — clear tracked state
- (do
- (set! prev-classes (list))
- (set! prev-extra-keys (list))))))))))
-
-;; reactive-fragment — conditionally render a fragment based on a signal
-;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
-(define reactive-fragment :effects [render mutation]
- (fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string))
- (let ((marker (create-comment "island-fragment"))
- (current-nodes (list)))
- (effect (fn ()
- ;; Remove previous nodes
- (for-each (fn (n) (dom-remove n)) current-nodes)
- (set! current-nodes (list))
- ;; If test passes, render and insert after marker
- (when (test-fn)
- (let ((frag (render-fn)))
- (set! current-nodes (dom-child-nodes frag))
- (dom-insert-after marker frag)))))
- marker)))
-
-;; reactive-list — render a keyed list bound to a signal
-;; Used for (map fn (deref items)) inside an island.
-;;
-;; Keyed reconciliation: if rendered elements have a "key" attribute,
-;; existing DOM nodes are reused across updates. Only additions, removals,
-;; and reorderings touch the DOM. Without keys, falls back to clear+rerender.
-
-(define render-list-item :effects [render]
- (fn ((map-fn :as lambda) item (env :as dict) (ns :as string))
- (if (lambda? map-fn)
- (render-lambda-dom map-fn (list item) env ns)
- (render-to-dom (apply map-fn (list item)) env ns))))
-
-(define extract-key :effects [render]
- (fn (node (index :as number))
- ;; Extract key from rendered node: :key attr, data-key, or index fallback
- (let ((k (dom-get-attr node "key")))
- (if k
- (do (dom-remove-attr node "key") k)
- (let ((dk (dom-get-data node "key")))
- (if dk (str dk) (str "__idx_" index)))))))
-
-(define reactive-list :effects [render mutation]
- (fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string))
- (let ((container (create-fragment))
- (marker (create-comment "island-list"))
- (key-map (dict))
- (key-order (list)))
- (dom-append container marker)
- (effect (fn ()
- (let ((items (deref items-sig)))
- (if (dom-parent marker)
- ;; Marker in DOM: reconcile
- (let ((new-map (dict))
- (new-keys (list))
- (has-keys false))
-
- ;; Render or reuse each item
- (for-each-indexed
- (fn (idx item)
- (let ((rendered (render-list-item map-fn item env ns))
- (key (extract-key rendered idx)))
- (when (and (not has-keys)
- (not (starts-with? key "__idx_")))
- (set! has-keys true))
- ;; Reuse existing node if key matches, else use new
- (if (dict-has? key-map key)
- (dict-set! new-map key (dict-get key-map key))
- (dict-set! new-map key rendered))
- (append! new-keys key)))
- items)
-
- (if (not has-keys)
- ;; No keys: simple clear and re-render (original strategy)
- (do
- (dom-remove-children-after marker)
- (let ((frag (create-fragment)))
- (for-each
- (fn (k) (dom-append frag (dict-get new-map k)))
- new-keys)
- (dom-insert-after marker frag)))
-
- ;; Keyed reconciliation
- (do
- ;; Remove stale nodes
- (for-each
- (fn (old-key)
- (when (not (dict-has? new-map old-key))
- (dom-remove (dict-get key-map old-key))))
- key-order)
-
- ;; Reorder/insert to match new key order
- (let ((cursor marker))
- (for-each
- (fn (k)
- (let ((node (dict-get new-map k))
- (next (dom-next-sibling cursor)))
- (when (not (identical? node next))
- (dom-insert-after cursor node))
- (set! cursor node)))
- new-keys))))
-
- ;; Update state for next render
- (set! key-map new-map)
- (set! key-order new-keys))
-
- ;; First run (marker not in DOM yet): render initial items into container
- (for-each-indexed
- (fn (idx item)
- (let ((rendered (render-list-item map-fn item env ns))
- (key (extract-key rendered idx)))
- (dict-set! key-map key rendered)
- (append! key-order key)
- (dom-append container rendered)))
- items)))))
- container)))
-
-
-;; --------------------------------------------------------------------------
-;; bind-input — two-way signal binding for form elements
-;; --------------------------------------------------------------------------
-;;
-;; (bind-input el sig) creates a bidirectional link:
-;; Signal → element: effect updates el.value (or el.checked) when sig changes
-;; Element → signal: input/change listener updates sig when user types
-;;
-;; Handles: input[text/number/email/...], textarea, select, checkbox, radio
-
-(define bind-input :effects [render mutation]
- (fn (el (sig :as signal))
- (let ((input-type (lower (or (dom-get-attr el "type") "")))
- (is-checkbox (or (= input-type "checkbox")
- (= input-type "radio"))))
- ;; Set initial value from signal
- (if is-checkbox
- (dom-set-prop el "checked" (deref sig))
- (dom-set-prop el "value" (str (deref sig))))
- ;; Signal → element (reactive effect)
- (effect (fn ()
- (if is-checkbox
- (dom-set-prop el "checked" (deref sig))
- (let ((v (str (deref sig))))
- (when (!= (dom-get-prop el "value") v)
- (dom-set-prop el "value" v))))))
- ;; Element → signal (event listener)
- (dom-on el (if is-checkbox "change" "input")
- (fn (e)
- (if is-checkbox
- (reset! sig (dom-get-prop el "checked"))
- (reset! sig (dom-get-prop el "value"))))))))
-
-
-;; --------------------------------------------------------------------------
-;; CEK-based reactive rendering (opt-in, deref-as-shift)
-;; --------------------------------------------------------------------------
-;;
-;; When enabled, (deref sig) inside a reactive-reset boundary performs
-;; continuation capture: "the rest of this expression" becomes the subscriber.
-;; No explicit effect() wrapping needed for text/attr bindings.
+(define bind-input :effects (render mutation) (fn (el (sig :as signal)) (let ((input-type (lower (or (dom-get-attr el "type") ""))) (is-checkbox (or (= input-type "checkbox") (= input-type "radio")))) (if is-checkbox (dom-set-prop el "checked" (deref sig)) (dom-set-prop el "value" (str (deref sig)))) (effect (fn () (if is-checkbox (dom-set-prop el "checked" (deref sig)) (let ((v (str (deref sig)))) (when (!= (dom-get-prop el "value") v) (dom-set-prop el "value" v)))))) (dom-on el (if is-checkbox "change" "input") (fn (e) (if is-checkbox (reset! sig (dom-get-prop el "checked")) (reset! sig (dom-get-prop el "value"))))))))
(define *use-cek-reactive* true)
+
(define enable-cek-reactive! (fn () (set! *use-cek-reactive* true)))
-;; cek-reactive-text — create a text node bound via continuation capture
-(define cek-reactive-text :effects [render mutation]
- (fn (expr env)
- (let ((node (create-text-node ""))
- (update-fn (fn (val)
- (dom-set-text-content node (str val)))))
- (let ((initial (cek-run
- (make-cek-state expr env
- (list (make-reactive-reset-frame env update-fn true))))))
- (dom-set-text-content node (str initial))
- node))))
+(define cek-reactive-text :effects (render mutation) (fn (expr env) (let ((node (create-text-node "")) (update-fn (fn (val) (dom-set-text-content node (str val))))) (let ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) (dom-set-text-content node (str initial)) node))))
-;; cek-reactive-attr — bind an attribute via continuation capture
-(define cek-reactive-attr :effects [render mutation]
- (fn (el attr-name expr env)
- (let ((update-fn (fn (val)
- (cond
- (or (nil? val) (= val false)) (dom-remove-attr el attr-name)
- (= val true) (dom-set-attr el attr-name "")
- :else (dom-set-attr el attr-name (str val))))))
- ;; Mark for morph protection
- (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
- (updated (if (empty? existing) attr-name (str existing "," attr-name))))
- (dom-set-attr el "data-sx-reactive-attrs" updated))
- ;; Initial render via CEK with ReactiveResetFrame
- (let ((initial (cek-run
- (make-cek-state expr env
- (list (make-reactive-reset-frame env update-fn true))))))
- (cek-call update-fn (list initial))))))
+(define cek-reactive-attr :effects (render mutation) (fn (el attr-name expr env) (let ((update-fn (fn (val) (cond (or (nil? val) (= val false)) (dom-remove-attr el attr-name) (= val true) (dom-set-attr el attr-name "") :else (dom-set-attr el attr-name (str val)))))) (let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") "")) (updated (if (empty? existing) attr-name (str existing "," attr-name)))) (dom-set-attr el "data-sx-reactive-attrs" updated)) (let ((initial (cek-run (make-cek-state expr env (list (make-reactive-reset-frame env update-fn true)))))) (cek-call update-fn (list initial))))))
+(define render-dom-portal :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((selector (trampoline (eval-expr (first args) env))) (target (or (dom-query selector) (dom-ensure-element selector)))) (if (not target) (create-comment (str "portal: " selector " (not found)")) (let ((marker (create-comment (str "portal: " selector))) (frag (create-fragment))) (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) (rest args)) (let ((portal-nodes (dom-child-nodes frag))) (dom-append target frag) (register-in-scope (fn () (for-each (fn (n) (dom-remove n)) portal-nodes)))) marker)))))
-;; --------------------------------------------------------------------------
-;; render-dom-portal — render children into a remote target element
-;; --------------------------------------------------------------------------
-;;
-;; (portal "#modal-root" (div "content"))
-;;
-;; Renders children into the DOM node matched by the selector, rather than
-;; into the current position. Returns a comment marker at the original
-;; position. Registers a disposer to clean up portal content on island
-;; teardown.
-
-(define render-dom-portal :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((selector (trampoline (eval-expr (first args) env)))
- (target (or (dom-query selector)
- (dom-ensure-element selector))))
- (if (not target)
- (create-comment (str "portal: " selector " (not found)"))
- (let ((marker (create-comment (str "portal: " selector)))
- (frag (create-fragment)))
- ;; Render children into the fragment
- (for-each
- (fn (child) (dom-append frag (render-to-dom child env ns)))
- (rest args))
- ;; Track portal nodes for disposal
- (let ((portal-nodes (dom-child-nodes frag)))
- ;; Append into remote target
- (dom-append target frag)
- ;; Register disposer: remove portal content on island teardown
- (register-in-scope
- (fn ()
- (for-each (fn (n) (dom-remove n)) portal-nodes))))
- ;; Return marker at original position
- marker)))))
-
-
-;; --------------------------------------------------------------------------
-;; render-dom-error-boundary — catch errors, render fallback UI
-;; --------------------------------------------------------------------------
-;;
-;; (error-boundary fallback-fn body...)
-;;
-;; Renders body children inside a try/catch. If any child throws during
-;; rendering, the fallback function is called with the error object, and
-;; its result is rendered instead. Effects within the boundary are disposed
-;; on error.
-;;
-;; The fallback function receives the error and a retry thunk:
-;; (fn (err retry) ...)
-;; Calling (retry) re-renders the body, replacing the fallback.
-
-(define render-dom-error-boundary :effects [render]
- (fn ((args :as list) (env :as dict) (ns :as string))
- (let ((fallback-expr (first args))
- (body-exprs (rest args))
- (container (dom-create-element "div" nil))
- ;; retry-version: bump this signal to force re-render after fallback
- (retry-version (signal 0)))
- (dom-set-attr container "data-sx-boundary" "true")
-
- ;; The entire body is rendered inside ONE effect + try-catch.
- ;; Body renders WITHOUT island scope so that if/when/cond use static
- ;; paths — their signal reads become direct deref calls tracked by THIS
- ;; effect. Errors from signal changes throw synchronously within try-catch.
- ;; The error boundary's own effect handles all reactivity for its subtree.
- (effect (fn ()
- ;; Touch retry-version so the effect re-runs when retry is called
- (deref retry-version)
-
- ;; Clear container
- (dom-set-prop container "innerHTML" "")
-
- ;; Push nil island scope to suppress reactive rendering in body.
- ;; Pop in both success and error paths.
- (scope-push! "sx-island-scope" nil)
- (try-catch
- (fn ()
- ;; Body renders statically — signal reads tracked by THIS effect,
- ;; throws propagate to our try-catch.
- (let ((frag (create-fragment)))
- (for-each
- (fn (child)
- (dom-append frag (render-to-dom child env ns)))
- body-exprs)
- (dom-append container frag))
- (scope-pop! "sx-island-scope"))
- (fn (err)
- ;; Pop scope first, then render fallback
- (scope-pop! "sx-island-scope")
- (let ((fallback-fn (trampoline (eval-expr fallback-expr env)))
- (retry-fn (fn () (swap! retry-version (fn (n) (+ n 1))))))
- (let ((fallback-dom
- (if (lambda? fallback-fn)
- (render-lambda-dom fallback-fn (list err retry-fn) env ns)
- (render-to-dom (apply fallback-fn (list err retry-fn)) env ns))))
- (dom-append container fallback-dom)))))))
-
- container)))
-
-
-;; --------------------------------------------------------------------------
-;; 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
-;; (create-comment s) → Comment node
-;;
-;; Tree mutation:
-;; (dom-append parent child) → void (appendChild)
-;; (dom-set-attr el name val) → void (setAttribute)
-;; (dom-remove-attr el name) → void (removeAttribute)
-;; (dom-get-attr el name) → string or nil (getAttribute)
-;; (dom-set-text-content n s) → void (set textContent)
-;; (dom-remove node) → void (remove from parent)
-;; (dom-insert-after ref node) → void (insert node after ref)
-;; (dom-parent node) → parent Element or nil
-;; (dom-child-nodes frag) → list of child nodes
-;; (dom-remove-children-after m)→ void (remove all siblings after marker)
-;; (dom-set-data el key val) → void (store arbitrary data on element)
-;; (dom-get-data el key) → any (retrieve data stored on element)
-;;
-;; Property access (for input binding):
-;; (dom-set-prop el name val) → void (set JS property: el[name] = val)
-;; (dom-get-prop el name) → any (read JS property: el[name])
-;;
-;; Query (for portals):
-;; (dom-query selector) → Element or nil (document.querySelector)
-;;
-;; Event handling:
-;; (dom-listen el name handler) → remove-fn (addEventListener, returns remover)
-;; (dom-dispatch el name detail)→ boolean (dispatch CustomEvent, bubbles: true)
-;;
-;; 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?
-;;
-;; From eval.sx:
-;; eval-expr, trampoline, expand-macro, process-bindings, eval-cond
-;; env-has?, env-get, env-set!, env-merge
-;; lambda?, component?, island?, macro?
-;; lambda-closure, lambda-params, lambda-body
-;; component-params, component-body, component-closure,
-;; component-has-children?, component-name
-;;
-;; From signals.sx:
-;; signal, deref, reset!, swap!, computed, effect, batch
-;; signal?, with-island-scope, register-in-scope
-;;
-;; Pure primitives used:
-;; keys, get, str
-;;
-;; Iteration:
-;; (for-each-indexed fn coll) → call fn(index, item) for each element
-;; --------------------------------------------------------------------------
+(define render-dom-error-boundary :effects (render) (fn ((args :as list) (env :as dict) (ns :as string)) (let ((fallback-expr (first args)) (body-exprs (rest args)) (container (dom-create-element "div" nil)) (retry-version (signal 0))) (dom-set-attr container "data-sx-boundary" "true") (effect (fn () (deref retry-version) (dom-set-prop container "innerHTML" "") (scope-push! "sx-island-scope" nil) (try-catch (fn () (let ((frag (create-fragment))) (for-each (fn (child) (dom-append frag (render-to-dom child env ns))) body-exprs) (dom-append container frag)) (scope-pop! "sx-island-scope")) (fn (err) (scope-pop! "sx-island-scope") (let ((fallback-fn (trampoline (eval-expr fallback-expr env))) (retry-fn (fn () (swap! retry-version (fn (n) (+ n 1)))))) (let ((fallback-dom (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns)))) (dom-append container fallback-dom))))))) container)))