Fix <vm:anon> display: move effect to _eff let binding

The effect form returns a VM closure (disposer) which the island DOM
renderer displayed as text. Moving it to a let binding (_eff) captures
the return value without rendering it.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-13 10:25:58 +00:00
parent d938682469
commit eb060ef32c

View File

@@ -1,4 +1,4 @@
;; Pretext island — full version with :ref (bug fix applied) ;; Pretext island — effect as let binding
(defisland (defisland
~pretext-demo/live ~pretext-demo/live
() ()
@@ -10,7 +10,8 @@
(doc (host-global "document")) (doc (host-global "document"))
(canvas (host-call doc "createElement" "canvas")) (canvas (host-call doc "createElement" "canvas"))
(ctx (host-call canvas "getContext" "2d")) (ctx (host-call canvas "getContext" "2d"))
(el-ref (signal nil))) (el-ref (signal nil))
(_eff
(effect (effect
(fn (fn
() ()
@@ -21,31 +22,27 @@
(opt (deref use-optimal))) (opt (deref use-optimal)))
(when (when
el el
(let
((lh (* sz 1.5)))
(host-set! (host-set!
ctx ctx
"font" "font"
(str sz "px 'Pretext Serif', DejaVu Serif, serif")) (str sz "px 'Pretext Serif', DejaVu Serif, serif"))
(let (let
((widths (map (fn (wd) (host-get (host-call ctx "measureText" wd) "width")) words)) ((lh (* sz 1.5))
(spw (host-get (host-call ctx "measureText" " ") "width"))) (widths
(map
(fn
(wd)
(host-get (host-call ctx "measureText" wd) "width"))
words))
(spw
(host-get (host-call ctx "measureText" " ") "width")))
(let (let
((ranges (if opt (break-lines widths spw w) (break-lines-greedy widths spw w))) ((ranges (if opt (break-lines widths spw w) (break-lines-greedy widths spw w))))
(lines (let
(pretext-layout-lines ((lines (pretext-layout-lines words widths ranges spw w lh))
words (info (host-call doc "createElement" "div"))
widths (container (host-call doc "createElement" "div")))
(if
opt
(break-lines widths spw w)
(break-lines-greedy widths spw w))
spw
w
lh)))
(host-set! el "innerHTML" "") (host-set! el "innerHTML" "")
(let
((info (host-call doc "createElement" "div")))
(host-set! info "className" "px-4 pt-3 pb-1") (host-set! info "className" "px-4 pt-3 pb-1")
(host-set! (host-set!
info info
@@ -60,18 +57,16 @@
"px / " "px / "
(if opt "optimal" "greedy") (if opt "optimal" "greedy")
"</span>")) "</span>"))
(host-call el "appendChild" info)) (host-call el "appendChild" info)
(let
((container (host-call doc "createElement" "div")))
(host-set! (host-set!
container container
"style" "style"
(str (str
"position:relative;height:" "position:relative;height:"
(* (len lines) lh) (+ (* (len lines) lh) 24)
"px;padding:12px 16px")) "px;padding:12px 16px"))
(let (let
render-lines rl
((li 0)) ((li 0))
(when (when
(< li (len lines)) (< li (len lines))
@@ -79,7 +74,7 @@
((line (nth lines li)) ((line (nth lines li))
(wds (get (nth lines li) :words))) (wds (get (nth lines li) :words)))
(let (let
render-words rw
((wi 0)) ((wi 0))
(when (when
(< wi (len wds)) (< wi (len wds))
@@ -87,7 +82,10 @@
((pw (nth wds wi)) ((pw (nth wds wi))
(span (span
(host-call doc "createElement" "span"))) (host-call doc "createElement" "span")))
(host-set! span "textContent" (get pw :word)) (host-set!
span
"textContent"
(get pw :word))
(host-set! (host-set!
span span
"style" "style"
@@ -100,9 +98,9 @@
sz sz
"px 'Pretext Serif',serif;white-space:nowrap")) "px 'Pretext Serif',serif;white-space:nowrap"))
(host-call container "appendChild" span) (host-call container "appendChild" span)
(render-words (+ wi 1)))))) (rw (+ wi 1))))))
(render-lines (+ li 1)))) (rl (+ li 1))))
(host-call el "appendChild" container))))))))) (host-call el "appendChild" container))))))))))
(div (div
(~tw :tokens "space-y-4") (~tw :tokens "space-y-4")
(div (div
@@ -144,6 +142,6 @@
:on-click (fn (e) (reset! use-optimal (not (deref use-optimal)))) :on-click (fn (e) (reset! use-optimal (not (deref use-optimal))))
(if (deref use-optimal) "Knuth-Plass" "Greedy")))) (if (deref use-optimal) "Knuth-Plass" "Greedy"))))
(div (div
:class "rounded-lg border border-stone-200 bg-white overflow-hidden" :class "rounded-lg border border-stone-200 bg-white"
:ref (fn (el) (reset! el-ref el)) :ref (fn (el) (reset! el-ref el))
"")))) ""))))