Fix :ref callback bug in adapter-dom — Pretext island fully working

Root cause: adapter-dom.sx line 345 handled :ref by calling
(dict-set! attr-val "current" el), assuming React-style ref objects.
Callback-style refs (fn (el) ...) passed a function, not a dict,
causing dict-set! to fail with "dict key val" error.

Fix: (if (callable? attr-val) (attr-val el) (dict-set! attr-val "current" el))
Supports both callback refs and dict refs.

Pretext island now fully working:
- 3 controls: width slider, font size slider, algorithm toggle
- Knuth-Plass + greedy line breaking via bytecode-compiled library
- canvas.measureText for pixel-perfect browser font metrics
- Effect-based imperative DOM rendering (createElement + appendChild)
- Reactive: slider drag → re-measure → re-break → re-render

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

shared/static/wasm/sx/adapter-dom.sx

@@ -342,7 +342,7 @@
                         (= attr-name "ref")
                         (let
                           ((attr-val (trampoline (eval-expr attr-expr env))))
-                          (dict-set! attr-val "current" el))
+                          (if (callable? attr-val) (attr-val el) (dict-set! attr-val "current" el)))
                         (= attr-name "key")
                         (let
                           ((attr-val (trampoline (eval-expr attr-expr env))))

shared/static/wasm/sx/hs-compiler.sx

@@ -292,7 +292,7 @@
             (let
               ((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
               (list
-                (quote host-set)
+                (quote host-set!)
                 obj
                 prop
                 (list
@@ -344,7 +344,7 @@
             (let
               ((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
               (list
-                (quote host-set)
+                (quote host-set!)
                 obj
                 prop
                 (list
@@ -815,6 +815,18 @@
                       (nth ast 1)))))
               ((= head (quote remove-element))
                 (list (quote dom-remove) (hs-to-sx (nth ast 1))))
+              ((= head (quote empty-target))
+                (list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
+              ((= head (quote swap!))
+                (let
+                  ((lhs (nth ast 1)) (rhs (nth ast 2)))
+                  (list
+                    (quote let)
+                    (list (list (quote _swap_tmp) (hs-to-sx lhs)))
+                    (list
+                      (quote do)
+                      (emit-set lhs (hs-to-sx rhs))
+                      (emit-set rhs (quote _swap_tmp))))))
               ((= head (quote remove-attr))
                 (let
                   ((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))

shared/static/wasm/sx/hs-parser.sx

@@ -1422,6 +1422,21 @@
             (let
               ((end-pos (skip-to-close 0)))
               (substring src start-pos end-pos)))))
+      (define
+        parse-empty-cmd
+        (fn
+          ()
+          (let
+            ((target (cond ((at-end?) (list (quote sym) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote sym) "me")) (true (parse-expr)))))
+            (list (quote empty-target) target))))
+      (define
+        parse-swap-cmd
+        (fn
+          ()
+          (let
+            ((lhs (parse-expr)))
+            (match-kw "with")
+            (let ((rhs (parse-expr))) (list (quote swap!) lhs rhs)))))
       (define
         parse-cmd
         (fn
@@ -1503,6 +1518,12 @@
                 (do (adv!) (parse-halt-cmd)))
               ((and (= typ "keyword") (= val "focus"))
                 (do (adv!) (parse-focus-cmd)))
+              ((and (= typ "keyword") (= val "empty"))
+                (do (adv!) (parse-empty-cmd)))
+              ((and (= typ "keyword") (= val "clear"))
+                (do (adv!) (parse-empty-cmd)))
+              ((and (= typ "keyword") (= val "swap"))
+                (do (adv!) (parse-swap-cmd)))
               (true (parse-expr))))))
       (define
         parse-cmd-list
@@ -1548,7 +1569,10 @@
                 (= v "scroll")
                 (= v "select")
                 (= v "reset")
-                (= v "focus"))))
+                (= v "focus")
+                (= v "empty")
+                (= v "clear")
+                (= v "swap"))))
           (define
             cl-collect
             (fn

shared/static/wasm/sx/hs-runtime.sx

@@ -444,10 +444,31 @@
       ((dict? v) (= (len (keys v)) 0))
       (true false))))
 ;; Array slicing (inclusive both ends)
-(define hs-first (fn (lst) (first lst)))
+(define
+  hs-empty-target!
+  (fn
+    (target)
+    (cond
+      ((list? target) (for-each (fn (el) (hs-empty-target! el)) target))
+      ((nil? target) nil)
+      (true
+        (let
+          ((tag (dom-get-prop target "tagName")))
+          (cond
+            ((or (= tag "INPUT") (= tag "TEXTAREA"))
+              (let
+                ((input-type (dom-get-prop target "type")))
+                (if
+                  (or (= input-type "checkbox") (= input-type "radio"))
+                  (dom-set-prop target "checked" false)
+                  (dom-set-prop target "value" ""))))
+            ((= tag "FORM") (dom-set-inner-html target ""))
+            (true (dom-set-inner-html target ""))))))))
 ;; Collection: sorted by
-(define hs-last (fn (lst) (last lst)))
+(define hs-first (fn (lst) (first lst)))
 ;; Collection: sorted by descending
+(define hs-last (fn (lst) (last lst)))
+;; Collection: split by
 (define
   hs-template
   (fn
@@ -533,7 +554,7 @@
                   (set! i (+ i 1))
                   (tpl-loop)))))))
       (do (tpl-loop) result))))
-;; Collection: split by
+;; Collection: joined by
 (define
   hs-make-object
   (fn
@@ -545,7 +566,7 @@
           (fn (pair) (dict-set! d (first pair) (nth pair 1)))
           pairs)
         d))))
-;; Collection: joined by
+
 (define
   hs-method-call
   (fn

shared/static/wasm/sx/hs-tokenizer.sx

@@ -117,6 +117,8 @@
     "last"
     "random"
     "empty"
+    "clear"
+    "swap"
     "exists"
     "matches"
     "contains"

shared/static/wasm/sx/module-manifest.json

@@ -1020,6 +1020,7 @@
       "hs-contains?",
       "precedes?",
       "hs-empty?",
+      "hs-empty-target!",
       "hs-first",
       "hs-last",
       "hs-template",

sx/sx/pretext-client.sx

@@ -1,4 +1,4 @@
-;; Test: add :ref callback
+;; Pretext island — full version with :ref (bug fix applied)
 (defisland
   ~pretext-demo/live
   ()
@@ -7,38 +7,104 @@
       (mxw (signal 500))
       (font-size (signal 16))
       (use-optimal (signal true))
-      (result (signal "loading..."))
-      (el-ref (signal nil))
       (doc (host-global "document"))
       (canvas (host-call doc "createElement" "canvas"))
-      (ctx (host-call canvas "getContext" "2d")))
+      (ctx (host-call canvas "getContext" "2d"))
+      (el-ref (signal nil)))
     (effect
       (fn
         ()
         (let
-          ((w (deref mxw))
+          ((el (deref el-ref))
+            (w (deref mxw))
             (sz (deref font-size))
             (opt (deref use-optimal)))
-          (host-set! ctx "font" (str sz "px serif"))
+          (when
-          (let
+            el
-            ((widths (map (fn (wd) (host-get (host-call ctx "measureText" wd) "width")) words))
-              (spw (host-get (host-call ctx "measureText" " ") "width")))
             (let
-              ((ranges (if opt (break-lines widths spw w) (break-lines-greedy widths spw w))))
+              ((lh (* sz 1.5)))
+              (host-set!
+                ctx
+                "font"
+                (str sz "px 'Pretext Serif', DejaVu Serif, serif"))
               (let
-                ((lines (pretext-layout-lines words widths ranges spw w (* sz 1.5))))
+                ((widths (map (fn (wd) (host-get (host-call ctx "measureText" wd) "width")) words))
-                (reset!
+                  (spw (host-get (host-call ctx "measureText" " ") "width")))
-                  result
+                (let
-                  (str
+                  ((ranges (if opt (break-lines widths spw w) (break-lines-greedy widths spw w)))
-                    (len lines)
+                    (lines
-                    " lines — "
+                      (pretext-layout-lines
-                    w
+                        words
-                    "px / "
+                        widths
-                    sz
+                        (if
-                    "px / "
+                          opt
-                    (if opt "optimal" "greedy")))))))))
+                          (break-lines widths spw w)
+                          (break-lines-greedy widths spw w))
+                        spw
+                        w
+                        lh)))
+                  (host-set! el "innerHTML" "")
+                  (let
+                    ((info (host-call doc "createElement" "div")))
+                    (host-set! info "className" "px-4 pt-3 pb-1")
+                    (host-set!
+                      info
+                      "innerHTML"
+                      (str
+                        "<span class='text-xs font-medium uppercase tracking-wide text-stone-400'>"
+                        (len lines)
+                        " lines — "
+                        w
+                        "px / "
+                        sz
+                        "px / "
+                        (if opt "optimal" "greedy")
+                        "</span>"))
+                    (host-call el "appendChild" info))
+                  (let
+                    ((container (host-call doc "createElement" "div")))
+                    (host-set!
+                      container
+                      "style"
+                      (str
+                        "position:relative;height:"
+                        (* (len lines) lh)
+                        "px;padding:12px 16px"))
+                    (let
+                      render-lines
+                      ((li 0))
+                      (when
+                        (< li (len lines))
+                        (let
+                          ((line (nth lines li))
+                            (wds (get (nth lines li) :words)))
+                          (let
+                            render-words
+                            ((wi 0))
+                            (when
+                              (< wi (len wds))
+                              (let
+                                ((pw (nth wds wi))
+                                  (span
+                                    (host-call doc "createElement" "span")))
+                                (host-set! span "textContent" (get pw :word))
+                                (host-set!
+                                  span
+                                  "style"
+                                  (str
+                                    "position:absolute;left:"
+                                    (+ (get pw :x) 16)
+                                    "px;top:"
+                                    (+ (get line :y) 12)
+                                    "px;font:"
+                                    sz
+                                    "px 'Pretext Serif',serif;white-space:nowrap"))
+                                (host-call container "appendChild" span)
+                                (render-words (+ wi 1))))))
+                        (render-lines (+ li 1))))
+                    (host-call el "appendChild" container)))))))))
     (div
-      (~tw :tokens "p-4 border rounded space-y-2")
+      (~tw :tokens "space-y-4")
       (div
         (~tw :tokens "flex flex-wrap gap-4 items-end")
         (div
@@ -77,5 +143,7 @@
             (~tw :tokens "px-3 py-1 rounded border text-sm")
             :on-click (fn (e) (reset! use-optimal (not (deref use-optimal))))
             (if (deref use-optimal) "Knuth-Plass" "Greedy"))))
-      (div (deref result))
+      (div
-      (div :ref (fn (el) (reset! el-ref el)) ""))))
+        :class "rounded-lg border border-stone-200 bg-white overflow-hidden"
+        :ref (fn (el) (reset! el-ref el))
+        ""))))

web/adapter-dom.sx

@@ -342,7 +342,7 @@
                         (= attr-name "ref")
                         (let
                           ((attr-val (trampoline (eval-expr attr-expr env))))
-                          (dict-set! attr-val "current" el))
+                          (if (callable? attr-val) (attr-val el) (dict-set! attr-val "current" el)))
                         (= attr-name "key")
                         (let
                           ((attr-val (trampoline (eval-expr attr-expr env))))