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

Fix lambda multi-body, reactive island demos, and add React is Hypermedia essay
Some checks failed
Build and Deploy / build-and-deploy (push) Has been cancelled
Details

Browse Source 
Lambda multi-body fix: sf-lambda used (nth args 1), dropping all but the first
body expression. Fixed to collect all body expressions and wrap in (begin ...).
This was foundational — every multi-expression lambda in every island silently
dropped expressions after the first.

Reactive islands: fix dom-parent marker timing (first effect run before marker
is in DOM), fix :key eager evaluation, fix error boundary scope isolation,
fix resource/suspense reactive cond tracking, fix inc not available as JS var.

New essay: "React is Hypermedia" — argues that reactive islands are hypermedia
controls whose behavior is specified in SX, not a departure from hypermedia.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-08 20:00:44 +00:00
parent 06adbdcd59
commit 56589a81b2
12 changed files with 1047 additions and 4010 deletions
Download Patch File Download Diff File Expand all files Collapse all files

310
shared/sx/ref/adapter-dom.sx
View File

@@ -169,34 +169,42 @@
(< (inc (get state "i")) (len args)))
;; Keyword arg → attribute
(let ((attr-name (keyword-name arg))
(attr-val (trampoline
(eval-expr
(nth args (inc (get state "i")))
env))))
(attr-expr (nth args (inc (get state "i")))))
(cond
;; nil or false → skip
(or (nil? attr-val) (= attr-val false))
nil
;; Event handler: on-click, on-submit, on-input, etc.
;; Value must be callable (lambda/function)
(and (starts-with? attr-name "on-")
(callable? attr-val))
(dom-listen el (slice attr-name 3) attr-val)
;; 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-listen el (slice attr-name 3) attr-val)))
;; Two-way input binding: :bind signal
(and (= attr-name "bind") (signal? attr-val))
(bind-input el attr-val)
(= 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")
(dict-set! attr-val "current" el)
;; Boolean attr
(contains? BOOLEAN_ATTRS attr-name)
(when attr-val (dom-set-attr el attr-name ""))
;; true → empty attr
(= attr-val true)
(dom-set-attr el attr-name "")
;; Normal attr
(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
(dom-set-attr el attr-name (str attr-val)))
(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
@@ -319,32 +327,131 @@
(define dispatch-render-form
(fn (name expr env ns)
(cond
;; if
;; if — reactive inside islands (re-renders when signal deps change)
(= name "if")
(let ((cond-val (trampoline (eval-expr (nth expr 1) env))))
(if cond-val
(render-to-dom (nth expr 2) env ns)
(if (> (len expr) 3)
(render-to-dom (nth expr 3) env ns)
(create-fragment))))
(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)))))
;; Return fragment: marker + initial render 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
;; when — reactive inside islands
(= name "when")
(if (not (trampoline (eval-expr (nth expr 1) env)))
(create-fragment)
(let ((frag (create-fragment)))
(for-each
(fn (i)
(dom-append frag (render-to-dom (nth expr i) env ns)))
(range 2 (len expr)))
frag))
(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))))))
(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
;; cond — reactive inside islands
(= name "cond")
(let ((branch (eval-cond (rest expr) env)))
(if branch
(render-to-dom branch env ns)
(create-fragment)))
(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)))))))
(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")
@@ -429,11 +536,11 @@
;; portal — render children into a remote target element
(= name "portal")
(render-dom-portal args env ns)
(render-dom-portal (rest expr) env ns)
;; error-boundary — catch errors, render fallback
(= name "error-boundary")
(render-dom-error-boundary args env ns)
(render-dom-error-boundary (rest expr) env ns)
;; for-each (render variant)
(= name "for-each")
@@ -620,9 +727,9 @@
(key-order (list)))
(dom-append container marker)
(effect (fn ()
(let ((parent (dom-parent marker))
(items (deref items-sig)))
(when parent
(let ((items (deref items-sig)))
(if (dom-parent marker)
;; Marker in DOM: reconcile
(let ((new-map (dict))
(new-keys (list))
(has-keys false))
@@ -674,7 +781,17 @@
;; Update state for next render
(set! key-map new-map)
(set! key-order new-keys))))))
(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)))
@@ -726,12 +843,10 @@
(define render-dom-portal
(fn (args env ns)
(let ((selector (trampoline (eval-expr (first args) env)))
(target (dom-query selector)))
(target (or (dom-query selector)
(dom-ensure-element selector))))
(if (not target)
;; Target not found — render nothing, log warning
(do
(log-warn (str "Portal target not found: " selector))
(create-comment (str "portal: " selector " (not found)")))
(create-comment (str "portal: " selector " (not found)"))
(let ((marker (create-comment (str "portal: " selector)))
(frag (create-fragment)))
;; Render children into the fragment
@@ -770,58 +885,49 @@
(let ((fallback-expr (first args))
(body-exprs (rest args))
(container (dom-create-element "div" nil))
(boundary-disposers (list)))
;; retry-version: bump this signal to force re-render after fallback
(retry-version (signal 0)))
(dom-set-attr container "data-sx-boundary" "true")
;; Render body with its own island scope for disposal
(let ((render-body
(fn ()
;; Dispose old boundary content
(for-each (fn (d) (d)) boundary-disposers)
(set! boundary-disposers (list))
;; 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" "")
;; Clear container
(dom-set-prop container "innerHTML" "")
;; Try to render body
(try-catch
(fn ()
;; Render body children, tracking disposers
(with-island-scope
(fn (disposable)
(append! boundary-disposers disposable)
(register-in-scope disposable))
(fn ()
(let ((frag (create-fragment)))
(for-each
(fn (child)
(dom-append frag (render-to-dom child env ns)))
body-exprs)
(dom-append container frag)))))
(fn (err)
;; Dispose any partially-created effects
(for-each (fn (d) (d)) boundary-disposers)
(set! boundary-disposers (list))
;; Save and clear island scope BEFORE try-catch so it can be
;; restored in both success and error paths.
(let ((saved-scope *island-scope*))
(set! *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))
(set! *island-scope* saved-scope))
(fn (err)
;; Restore scope first, then render fallback
(set! *island-scope* saved-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))))))))
;; Render fallback with error + retry
(let ((fallback-fn (trampoline (eval-expr fallback-expr env)))
(retry-fn (fn () (render-body))))
(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))))))))
;; Initial render
(render-body)
;; Register boundary disposers with parent island scope
(register-in-scope
(fn ()
(for-each (fn (d) (d)) boundary-disposers)
(set! boundary-disposers (list))))
container))))
container)))
;; --------------------------------------------------------------------------