coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

WIP: DOM-preserving hydration — SSR DOM stays, no visual flash

Browse Source 
Adds hydration cursor to render pipeline:
- boot.sx: *hydrating* flag, hydrate-start!/stop!, cursor stack helpers
- adapter-dom.sx: render-dom-element uses existing SSR elements when
  *hydrating* is true. Text nodes reused. dom-append skipped.
- hydrate-island: calls hydrate-start! before render-to-dom, no
  replaceChildren. SSR DOM stays in place.

Status: screenshots identical (no visual flash), but event listeners
not attaching — the cursor/set! interaction between CEK and VM needs
debugging. The hydrate-start! set! on *hydrating* may not propagate
to the bytecoded adapter-dom render path.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-10 10:40:09 +00:00
parent 3d05efbb9b
commit 0044f17e4c
6 changed files with 2658 additions and 2546 deletions
Download Patch File Download Diff File Expand all files Collapse all files

177
shared/static/wasm/sx/adapter-dom.sx
View File

@@ -1,16 +1,48 @@
(import (sx dom))
(import (sx render))
(define-library (web adapter-dom)
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary)
(define-library
(web adapter-dom)
(export
SVG_NS
MATH_NS
island-scope?
contains-deref?
dom-on
render-to-dom
render-dom-list
render-dom-element
render-dom-component
render-dom-fragment
render-dom-raw
render-dom-unknown-component
RENDER_DOM_FORMS
render-dom-form?
dispatch-render-form
render-lambda-dom
render-dom-island
render-dom-lake
render-dom-marsh
reactive-text
reactive-attr
reactive-spread
reactive-fragment
render-list-item
extract-key
reactive-list
bind-input
*use-cek-reactive*
enable-cek-reactive!
cek-reactive-text
cek-reactive-attr
render-dom-portal
render-dom-error-boundary)
(begin
(define SVG_NS "http://www.w3.org/2000/svg")
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope")))))
(define
island-scope?
(fn () (not (nil? (scope-peek "sx-island-scope")))))
(begin
(define *memo-cache* (dict))
(define *cyst-counter* 0)
@@ -20,7 +52,6 @@
()
(set! *cyst-counter* (+ *cyst-counter* 1))
(str "sx-cyst-" *cyst-counter*))))
(define
contains-deref?
(fn
@@ -37,7 +68,6 @@
(= (symbol-name (first expr)) "deref"))
true
(some contains-deref? expr))))))
(define
dom-on
:effects (io)
@@ -59,7 +89,6 @@
(trampoline (call-lambda handler (list e)))
(run-post-render-hooks)))
handler))))
(define
render-to-dom
:effects (render)
@@ -75,9 +104,15 @@
"raw-html"
(dom-parse-html (raw-html-content expr))
"string"
(create-text-node expr)
(if
*hydrating*
(or (hydrate-next-text!) (create-text-node expr))
(create-text-node expr))
"number"
(create-text-node (str expr))
(if
*hydrating*
(or (hydrate-next-text!) (create-text-node (str expr)))
(create-text-node (str expr)))
"symbol"
(render-to-dom (trampoline (eval-expr expr env)) env ns)
"keyword"
@@ -101,7 +136,6 @@
(reactive-text expr)
(create-text-node (str (deref expr))))
(create-text-node (str expr))))))
(define
render-dom-list
:effects (render)
@@ -136,7 +170,10 @@
(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)
(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
@@ -156,7 +193,12 @@
((skip (get state "skip")))
(if
skip
(assoc state "skip" false "i" (inc (get state "i")))
(assoc
state
"skip"
false
"i"
(inc (get state "i")))
(if
(and
(= (type-of arg) "keyword")
@@ -178,7 +220,10 @@
(assoc state "i" (inc (get state "i")))))))
(dict "i" 0 "skip" false)
args)
(dom-set-attr marker "data-sx-island" (component-name island))
(dom-set-attr
marker
"data-sx-island"
(component-name island))
(when
(not (empty-dict? kw-state))
(dom-set-attr
@@ -224,15 +269,21 @@
(when (not (spread? result)) (dom-append frag result))))
expr)
frag)))))
(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)))
((new-ns (if (= tag "svg") SVG_NS (if (= tag "math") MATH_NS ns)))
(el
(if
*hydrating*
(let
((existing (hydrate-next-element!)))
(when existing (hydrate-push! existing))
(or existing (dom-create-element tag new-ns)))
(dom-create-element tag new-ns))))
(scope-push! "element-attrs" nil)
(reduce
(fn
@@ -296,7 +347,7 @@
(fn () (render-to-dom arg env new-ns)))
(spread? child)
nil
:else (dom-append el child))))
:else (when (not *hydrating*) (dom-append el child)))))
(assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false)
args)
@@ -334,13 +385,15 @@
(keys spread-dict)))
(scope-emitted "element-attrs"))
(scope-pop! "element-attrs")
el)))
(do (when *hydrating* (hydrate-pop!)) el))))
(define
render-dom-component
:effects (render)
(fn
((comp :as component) (args :as list) (env :as dict) (ns :as string))
((comp :as component)
(args :as list)
(env :as dict)
(ns :as string))
(let
((kwargs (dict)) (children (list)))
(reduce
@@ -389,7 +442,6 @@
children)
(env-bind! local "children" child-frag)))
(render-to-dom (component-body comp) local ns)))))
(define
render-dom-fragment
:effects (render)
@@ -405,7 +457,6 @@
(when (not (spread? result)) (dom-append frag result))))
args)
frag)))
(define
render-dom-raw
:effects (render)
@@ -427,12 +478,10 @@
(dom-append frag (create-text-node (str val))))))
args)
frag)))
(define
render-dom-unknown-component
:effects (render)
(fn ((name :as string)) (error (str "Unknown component: " name))))
(define
RENDER_DOM_FORMS
(list
@@ -459,12 +508,10 @@
"scope"
"provide"
"cyst"))
(define
render-dom-form?
:effects ()
(fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
(define
dispatch-render-form
:effects (render)
@@ -555,7 +602,9 @@
(for-each
(fn
(i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(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))))))
@@ -670,7 +719,9 @@
bindings)
(when
(> (len body) 1)
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
(for-each
(fn (e) (trampoline (eval-expr e local)))
(init body)))
(render-to-dom (last body) local ns))
(or (= name "begin") (= name "do"))
(if
@@ -771,7 +822,9 @@
(= (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!
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)
@@ -787,7 +840,9 @@
(frag (create-fragment)))
(scope-push! prov-name prov-val)
(for-each
(fn (i) (dom-append frag (render-to-dom (nth expr i) env ns)))
(fn
(i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 3 (len expr)))
(scope-pop! prov-name)
frag)
@@ -817,7 +872,6 @@
(dict-set! *memo-cache* cyst-key container)
container))))
:else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
(define
render-lambda-dom
:effects (render)
@@ -829,12 +883,14 @@
(fn (i p) (env-bind! local p (nth args i)))
(lambda-params f))
(render-to-dom (lambda-body f) local ns))))
(define
render-dom-island
:effects (render mutation)
(fn
((island :as island) (args :as list) (env :as dict) (ns :as string))
((island :as island)
(args :as list)
(env :as dict)
(ns :as string))
(let
((kwargs (dict)) (children (list)))
(reduce
@@ -878,19 +934,22 @@
children)
(env-bind! local "children" child-frag)))
(let
((container (dom-create-element "span" nil)) (disposers (list)))
((container (dom-create-element "span" nil))
(disposers (list)))
(begin
(dom-set-attr container "data-sx-island" island-name)
(when
(not (empty-dict? kwargs))
(dom-set-attr container "data-sx-state" (sx-serialize kwargs))))
(dom-set-attr
container
"data-sx-state"
(sx-serialize kwargs))))
(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))))))
(define
render-dom-lake
:effects (render)
@@ -933,7 +992,6 @@
(fn (c) (dom-append el (render-to-dom c env ns)))
children)
el))))
(define
render-dom-marsh
:effects (render)
@@ -985,17 +1043,15 @@
(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)))))
((node (if *hydrating* (or (hydrate-next-text!) (create-text-node (str (deref sig)))) (create-text-node (str (deref sig))))))
(effect (fn () (dom-set-text-content node (str (deref sig)))))
node)))
(define
reactive-attr
:effects (render mutation)
@@ -1019,7 +1075,6 @@
(= val true)
(dom-set-attr el attr-name "")
:else (dom-set-attr el attr-name (str val)))))))))
(define
reactive-spread
:effects (render mutation)
@@ -1044,7 +1099,9 @@
(filter (fn (c) (not (= c ""))) (split current " ")))
(kept
(filter
(fn (c) (not (some (fn (pc) (= pc c)) prev-classes)))
(fn
(c)
(not (some (fn (pc) (= pc c)) prev-classes)))
tokens)))
(if
(empty? kept)
@@ -1059,7 +1116,9 @@
((attrs (spread-attrs result))
(cls-str (or (dict-get attrs "class") ""))
(new-classes
(filter (fn (c) (not (= c ""))) (split cls-str " ")))
(filter
(fn (c) (not (= c "")))
(split cls-str " ")))
(extra-keys
(filter (fn (k) (not (= k "class"))) (keys attrs))))
(set! prev-classes new-classes)
@@ -1079,8 +1138,9 @@
(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))))))))))
(do
(set! prev-classes (list))
(set! prev-extra-keys (list))))))))))
(define
reactive-fragment
:effects (render mutation)
@@ -1090,7 +1150,8 @@
(env :as dict)
(ns :as string))
(let
((marker (create-comment "island-fragment")) (current-nodes (list)))
((marker (create-comment "island-fragment"))
(current-nodes (list)))
(effect
(fn
()
@@ -1103,7 +1164,6 @@
(set! current-nodes (dom-child-nodes frag))
(dom-insert-after marker frag)))))
marker)))
(define
render-list-item
:effects (render)
@@ -1113,7 +1173,6 @@
(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)
@@ -1127,7 +1186,6 @@
(let
((dk (dom-get-data node "key")))
(if dk (str dk) (str "__idx_" index)))))))
(define
reactive-list
:effects (render mutation)
@@ -1212,7 +1270,6 @@
(dom-append container rendered)))
items)))))
container)))
(define
bind-input
:effects (render mutation)
@@ -1220,7 +1277,8 @@
(el (sig :as signal))
(let
((input-type (lower (or (dom-get-attr el "type") "")))
(is-checkbox (or (= input-type "checkbox") (= input-type "radio"))))
(is-checkbox
(or (= input-type "checkbox") (= input-type "radio"))))
(if
is-checkbox
(dom-set-prop el "checked" (deref sig))
@@ -1245,11 +1303,8 @@
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)))
(define
cek-reactive-text
:effects (render mutation)
@@ -1262,7 +1317,6 @@
((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-attr
:effects (render mutation)
@@ -1278,7 +1332,6 @@
(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)
@@ -1302,7 +1355,6 @@
(register-in-scope
(fn () (for-each (fn (n) (dom-remove n)) portal-nodes))))
marker)))))
(define
render-dom-error-boundary
:effects (render)
@@ -1342,10 +1394,7 @@
(let
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (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)))
))
container)))))
;; Re-export to global env
(import (web adapter-dom))

4
shared/static/wasm/sx/adapter-dom.sxbc
View File

File diff suppressed because one or more lines are too long

13
shared/static/wasm/sx/boot.sx
View File

@@ -55,6 +55,8 @@
(dom-append-to-head el)))))
els))))
(define *hydrating* false)
(define
sx-mount
:effects (mutation io)
@@ -329,9 +331,14 @@
p
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp))
(let
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el)))))
(host-call el "replaceChildren" body-dom)
(do
(hydrate-start! el)
(log-info " hydrate-start done")
(with-island-scope
(fn (disposable) (append! disposers disposable))
(fn () (render-to-dom (component-body comp) local nil)))
(log-info " render-to-dom done")
(hydrate-stop!)
(dom-set-data el "sx-disposers" disposers)
(set-timeout (fn () (process-elements el)) 0)
(log-info

4
shared/static/wasm/sx/boot.sxbc
View File

File diff suppressed because one or more lines are too long

177
web/adapter-dom.sx
View File

@@ -1,16 +1,48 @@
(import (sx dom))
(import (sx render))
(define-library (web adapter-dom)
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary)
(define-library
(web adapter-dom)
(export
SVG_NS
MATH_NS
island-scope?
contains-deref?
dom-on
render-to-dom
render-dom-list
render-dom-element
render-dom-component
render-dom-fragment
render-dom-raw
render-dom-unknown-component
RENDER_DOM_FORMS
render-dom-form?
dispatch-render-form
render-lambda-dom
render-dom-island
render-dom-lake
render-dom-marsh
reactive-text
reactive-attr
reactive-spread
reactive-fragment
render-list-item
extract-key
reactive-list
bind-input
*use-cek-reactive*
enable-cek-reactive!
cek-reactive-text
cek-reactive-attr
render-dom-portal
render-dom-error-boundary)
(begin
(define SVG_NS "http://www.w3.org/2000/svg")
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
(define island-scope? (fn () (not (nil? (scope-peek "sx-island-scope")))))
(define
island-scope?
(fn () (not (nil? (scope-peek "sx-island-scope")))))
(begin
(define *memo-cache* (dict))
(define *cyst-counter* 0)
@@ -20,7 +52,6 @@
()
(set! *cyst-counter* (+ *cyst-counter* 1))
(str "sx-cyst-" *cyst-counter*))))
(define
contains-deref?
(fn
@@ -37,7 +68,6 @@
(= (symbol-name (first expr)) "deref"))
true
(some contains-deref? expr))))))
(define
dom-on
:effects (io)
@@ -59,7 +89,6 @@
(trampoline (call-lambda handler (list e)))
(run-post-render-hooks)))
handler))))
(define
render-to-dom
:effects (render)
@@ -75,9 +104,15 @@
"raw-html"
(dom-parse-html (raw-html-content expr))
"string"
(create-text-node expr)
(if
*hydrating*
(or (hydrate-next-text!) (create-text-node expr))
(create-text-node expr))
"number"
(create-text-node (str expr))
(if
*hydrating*
(or (hydrate-next-text!) (create-text-node (str expr)))
(create-text-node (str expr)))
"symbol"
(render-to-dom (trampoline (eval-expr expr env)) env ns)
"keyword"
@@ -101,7 +136,6 @@
(reactive-text expr)
(create-text-node (str (deref expr))))
(create-text-node (str expr))))))
(define
render-dom-list
:effects (render)
@@ -136,7 +170,10 @@
(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)
(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
@@ -156,7 +193,12 @@
((skip (get state "skip")))
(if
skip
(assoc state "skip" false "i" (inc (get state "i")))
(assoc
state
"skip"
false
"i"
(inc (get state "i")))
(if
(and
(= (type-of arg) "keyword")
@@ -178,7 +220,10 @@
(assoc state "i" (inc (get state "i")))))))
(dict "i" 0 "skip" false)
args)
(dom-set-attr marker "data-sx-island" (component-name island))
(dom-set-attr
marker
"data-sx-island"
(component-name island))
(when
(not (empty-dict? kw-state))
(dom-set-attr
@@ -224,15 +269,21 @@
(when (not (spread? result)) (dom-append frag result))))
expr)
frag)))))
(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)))
((new-ns (if (= tag "svg") SVG_NS (if (= tag "math") MATH_NS ns)))
(el
(if
*hydrating*
(let
((existing (hydrate-next-element!)))
(when existing (hydrate-push! existing))
(or existing (dom-create-element tag new-ns)))
(dom-create-element tag new-ns))))
(scope-push! "element-attrs" nil)
(reduce
(fn
@@ -296,7 +347,7 @@
(fn () (render-to-dom arg env new-ns)))
(spread? child)
nil
:else (dom-append el child))))
:else (when (not *hydrating*) (dom-append el child)))))
(assoc state "i" (inc (get state "i"))))))))
(dict "i" 0 "skip" false)
args)
@@ -334,13 +385,15 @@
(keys spread-dict)))
(scope-emitted "element-attrs"))
(scope-pop! "element-attrs")
el)))
(do (when *hydrating* (hydrate-pop!)) el))))
(define
render-dom-component
:effects (render)
(fn
((comp :as component) (args :as list) (env :as dict) (ns :as string))
((comp :as component)
(args :as list)
(env :as dict)
(ns :as string))
(let
((kwargs (dict)) (children (list)))
(reduce
@@ -389,7 +442,6 @@
children)
(env-bind! local "children" child-frag)))
(render-to-dom (component-body comp) local ns)))))
(define
render-dom-fragment
:effects (render)
@@ -405,7 +457,6 @@
(when (not (spread? result)) (dom-append frag result))))
args)
frag)))
(define
render-dom-raw
:effects (render)
@@ -427,12 +478,10 @@
(dom-append frag (create-text-node (str val))))))
args)
frag)))
(define
render-dom-unknown-component
:effects (render)
(fn ((name :as string)) (error (str "Unknown component: " name))))
(define
RENDER_DOM_FORMS
(list
@@ -459,12 +508,10 @@
"scope"
"provide"
"cyst"))
(define
render-dom-form?
:effects ()
(fn ((name :as string)) (contains? RENDER_DOM_FORMS name)))
(define
dispatch-render-form
:effects (render)
@@ -555,7 +602,9 @@
(for-each
(fn
(i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(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))))))
@@ -670,7 +719,9 @@
bindings)
(when
(> (len body) 1)
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
(for-each
(fn (e) (trampoline (eval-expr e local)))
(init body)))
(render-to-dom (last body) local ns))
(or (= name "begin") (= name "do"))
(if
@@ -771,7 +822,9 @@
(= (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!
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)
@@ -787,7 +840,9 @@
(frag (create-fragment)))
(scope-push! prov-name prov-val)
(for-each
(fn (i) (dom-append frag (render-to-dom (nth expr i) env ns)))
(fn
(i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 3 (len expr)))
(scope-pop! prov-name)
frag)
@@ -817,7 +872,6 @@
(dict-set! *memo-cache* cyst-key container)
container))))
:else (render-to-dom (trampoline (eval-expr expr env)) env ns))))
(define
render-lambda-dom
:effects (render)
@@ -829,12 +883,14 @@
(fn (i p) (env-bind! local p (nth args i)))
(lambda-params f))
(render-to-dom (lambda-body f) local ns))))
(define
render-dom-island
:effects (render mutation)
(fn
((island :as island) (args :as list) (env :as dict) (ns :as string))
((island :as island)
(args :as list)
(env :as dict)
(ns :as string))
(let
((kwargs (dict)) (children (list)))
(reduce
@@ -878,19 +934,22 @@
children)
(env-bind! local "children" child-frag)))
(let
((container (dom-create-element "span" nil)) (disposers (list)))
((container (dom-create-element "span" nil))
(disposers (list)))
(begin
(dom-set-attr container "data-sx-island" island-name)
(when
(not (empty-dict? kwargs))
(dom-set-attr container "data-sx-state" (sx-serialize kwargs))))
(dom-set-attr
container
"data-sx-state"
(sx-serialize kwargs))))
(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))))))
(define
render-dom-lake
:effects (render)
@@ -933,7 +992,6 @@
(fn (c) (dom-append el (render-to-dom c env ns)))
children)
el))))
(define
render-dom-marsh
:effects (render)
@@ -985,17 +1043,15 @@
(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)))))
((node (if *hydrating* (or (hydrate-next-text!) (create-text-node (str (deref sig)))) (create-text-node (str (deref sig))))))
(effect (fn () (dom-set-text-content node (str (deref sig)))))
node)))
(define
reactive-attr
:effects (render mutation)
@@ -1019,7 +1075,6 @@
(= val true)
(dom-set-attr el attr-name "")
:else (dom-set-attr el attr-name (str val)))))))))
(define
reactive-spread
:effects (render mutation)
@@ -1044,7 +1099,9 @@
(filter (fn (c) (not (= c ""))) (split current " ")))
(kept
(filter
(fn (c) (not (some (fn (pc) (= pc c)) prev-classes)))
(fn
(c)
(not (some (fn (pc) (= pc c)) prev-classes)))
tokens)))
(if
(empty? kept)
@@ -1059,7 +1116,9 @@
((attrs (spread-attrs result))
(cls-str (or (dict-get attrs "class") ""))
(new-classes
(filter (fn (c) (not (= c ""))) (split cls-str " ")))
(filter
(fn (c) (not (= c "")))
(split cls-str " ")))
(extra-keys
(filter (fn (k) (not (= k "class"))) (keys attrs))))
(set! prev-classes new-classes)
@@ -1079,8 +1138,9 @@
(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))))))))))
(do
(set! prev-classes (list))
(set! prev-extra-keys (list))))))))))
(define
reactive-fragment
:effects (render mutation)
@@ -1090,7 +1150,8 @@
(env :as dict)
(ns :as string))
(let
((marker (create-comment "island-fragment")) (current-nodes (list)))
((marker (create-comment "island-fragment"))
(current-nodes (list)))
(effect
(fn
()
@@ -1103,7 +1164,6 @@
(set! current-nodes (dom-child-nodes frag))
(dom-insert-after marker frag)))))
marker)))
(define
render-list-item
:effects (render)
@@ -1113,7 +1173,6 @@
(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)
@@ -1127,7 +1186,6 @@
(let
((dk (dom-get-data node "key")))
(if dk (str dk) (str "__idx_" index)))))))
(define
reactive-list
:effects (render mutation)
@@ -1212,7 +1270,6 @@
(dom-append container rendered)))
items)))))
container)))
(define
bind-input
:effects (render mutation)
@@ -1220,7 +1277,8 @@
(el (sig :as signal))
(let
((input-type (lower (or (dom-get-attr el "type") "")))
(is-checkbox (or (= input-type "checkbox") (= input-type "radio"))))
(is-checkbox
(or (= input-type "checkbox") (= input-type "radio"))))
(if
is-checkbox
(dom-set-prop el "checked" (deref sig))
@@ -1245,11 +1303,8 @@
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)))
(define
cek-reactive-text
:effects (render mutation)
@@ -1262,7 +1317,6 @@
((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-attr
:effects (render mutation)
@@ -1278,7 +1332,6 @@
(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)
@@ -1302,7 +1355,6 @@
(register-in-scope
(fn () (for-each (fn (n) (dom-remove n)) portal-nodes))))
marker)))))
(define
render-dom-error-boundary
:effects (render)
@@ -1342,10 +1394,7 @@
(let
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (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)))
))
container)))))
;; Re-export to global env
(import (web adapter-dom))

13
web/boot.sx
View File

@@ -55,6 +55,8 @@
(dom-append-to-head el)))))
els))))
(define *hydrating* false)
(define
sx-mount
:effects (mutation io)
@@ -329,9 +331,14 @@
p
(if (dict-has? kwargs p) (dict-get kwargs p) nil)))
(component-params comp))
(let
((body-dom (cek-try (fn () (with-island-scope (fn (disposable) (append! disposers disposable)) (fn () (render-to-dom (component-body comp) local nil)))) (fn (err) (log-warn (str "hydrate-island FAILED: " comp-name " — " err)) (let ((error-el (dom-create-element "div" nil))) (dom-set-attr error-el "class" "sx-island-error") (dom-set-attr error-el "style" "padding:8px;margin:4px 0;border:1px solid #ef4444;border-radius:4px;background:#fef2f2;color:#b91c1c;font-family:monospace;font-size:12px;white-space:pre-wrap") (dom-set-text-content error-el (str "Island error: " comp-name "\n" err)) error-el)))))
(host-call el "replaceChildren" body-dom)
(do
(hydrate-start! el)
(log-info " hydrate-start done")
(with-island-scope
(fn (disposable) (append! disposers disposable))
(fn () (render-to-dom (component-body comp) local nil)))
(log-info " render-to-dom done")
(hydrate-stop!)
(dom-set-data el "sx-disposers" disposers)
(set-timeout (fn () (process-elements el)) 0)
(log-info