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

HS test generator: fix toHaveCSS, locals, and \"-escapes — +28 tests

Browse Source 
Generator changes (tests/playwright/generate-sx-tests.py):
- toHaveCSS regex: balance parens so `'rgb(255, 0, 0)'` is captured intact
  (was truncating at first `)`)
- Map browser-computed colors `rgb(R,G,B)` back to CSS keywords
  (red/green/blue/black/white) — our DOM mock returns the inline value
- js_val_to_sx now handles object literals `{a: 1, b: {c: 2}}` → `{:a 1 :b {:c 2}}`
- Pattern 2 (`var x = await run(...)`) now captures locals via balanced-brace
  scan and emits `eval-hs-locals` instead of `eval-hs`
- Pattern 1 with locals: emit `eval-hs-locals` (was wrapping in `let`, which
  doesn't reach the inner HS env)
- Stop collapsing `\"` → `"` in raw HTML (line 218): the backslash escapes
  are legitimate in single-quoted `_='...'` HS attribute values containing
  nested HS scripts

Test-framework changes (regenerated into spec/tests/test-hyperscript-behavioral.sx):
- `_hs-wrap-body`: returns expression value if non-nil, else `it`. Lets bare
  expressions (`foo.foo`) and `it`-mutating scripts (`pick first 3 of arr;
  set $test to it`) both round-trip through the same wrapper
- `eval-hs-locals` now injects locals via `(let ((name (quote val)) ...) sx)`
  rather than `apply handler (cons nil vals)` — works around a JIT loop on
  some compiled forms (e.g. `bar.doh of foo` with undefined `bar`)

Also synced lib/hyperscript/*.sx → shared/static/wasm/sx/hs-*.sx (the WASM
test runner reads from the wasm/sx/ copies).

Net per-cluster pass counts (vs prior baseline):
- put: 23 → 29 (+6)
- set: 21 → 28 (+7)
- show: 7 → 15 (+8)
- expressions/propertyAccess: 3 → 9 (+6)
- expressions/possessiveExpression: 17 → 18 (+1)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-23 09:18:21 +00:00
parent 0515295317
commit a11d0941e9
7 changed files with 451 additions and 194 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -77,7 +77,11 @@
((= th (quote ref))
(list (quote set!) (make-symbol (nth target 1)) value))
((= th (quote local))
(list (quote define) (make-symbol (nth target 1)) value))
(list
(quote hs-scoped-set!)
(quote me)
(nth target 1)
value))
((= th (quote dom-ref))
(list
(quote hs-dom-set!)
@@ -753,35 +757,53 @@
(hs-to-sx (nth ast 3))))
((= head (quote pick-first))
(list
(quote hs-pick-first)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
(quote set!)
(quote it)
(list
(quote hs-pick-first)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))))
((= head (quote pick-last))
(list
(quote hs-pick-last)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
(quote set!)
(quote it)
(list
(quote hs-pick-last)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))))
((= head (quote pick-random))
(list
(quote hs-pick-random)
(hs-to-sx (nth ast 1))
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))
(quote set!)
(quote it)
(list
(quote hs-pick-random)
(hs-to-sx (nth ast 1))
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2))))))
((= head (quote pick-items))
(list
(quote hs-pick-items)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
(quote set!)
(quote it)
(list
(quote hs-pick-items)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3)))))
((= head (quote pick-match))
(list
(quote regex-match)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
(quote set!)
(quote it)
(list
(quote regex-match)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))))
((= head (quote pick-matches))
(list
(quote regex-find-all)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
(quote set!)
(quote it)
(list
(quote regex-find-all)
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2)))))
((= head (quote prop-is))
(list
(quote hs-prop-is)
@@ -894,7 +916,8 @@
(quote dom-has-class?)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote local)) (make-symbol (nth ast 1)))
((= head (quote local))
(list (quote hs-scoped-get) (quote me) (nth ast 1)))
((= head (quote array))
(cons (quote list) (map hs-to-sx (rest ast))))
((= head (quote not))
@@ -1384,7 +1407,7 @@
nil))
((= head (quote hide))
(let
((tgt (hs-to-sx (nth ast 1)))
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(if
@@ -1400,7 +1423,7 @@
(hs-to-sx when-cond))))))
((= head (quote show))
(let
((tgt (hs-to-sx (nth ast 1)))
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(if

45
shared/static/wasm/sx/hs-integration.sx
View File

@@ -53,13 +53,20 @@
((sx (hs-to-sx-from-source src)))
(let
((extra-vars (hs-collect-vars sx)))
(let
((bindings (append (list (list (quote it) nil) (list (quote event) nil)) (map (fn (v) (list v nil)) extra-vars))))
(eval-expr-cek
(list
(quote fn)
(list (quote me))
(list (quote let) bindings sx)))))))))
(do
(for-each
(fn (v) (eval-expr-cek (list (quote define) v nil)))
extra-vars)
(let
((guarded (list (quote guard) (list (quote _e) (list (quote true) (list (quote if) (list (quote and) (list (quote list?) (quote _e)) (list (quote =) (list (quote first) (quote _e)) "hs-return")) (list (quote nth) (quote _e) 1) (list (quote raise) (quote _e))))) sx)))
(eval-expr-cek
(list
(quote fn)
(list (quote me))
(list
(quote let)
(list (list (quote it) nil) (list (quote event) nil))
guarded))))))))))
;; ── Activate a single element ───────────────────────────────────
;; Reads the _="..." attribute, compiles, and executes with me=element.
@@ -70,9 +77,10 @@
(fn
(el)
(let
((src (dom-get-attr el "_")))
((src (dom-get-attr el "_")) (prev (dom-get-data el "hs-script")))
(when
(and src (not (dom-get-data el "hs-active")))
(and src (not (= src prev)))
(dom-set-data el "hs-script" src)
(dom-set-data el "hs-active" true)
(let ((handler (hs-handler src))) (handler el))))))
@@ -80,6 +88,21 @@
;; Called once at page load. Finds all elements with _ attribute,
;; compiles their hyperscript, and activates them.
(define
hs-deactivate!
(fn
(el)
(let
((unlisteners (or (dom-get-data el "hs-unlisteners") (list))))
(for-each (fn (u) (when u (u))) unlisteners)
(dom-set-data el "hs-unlisteners" (list))
(dom-set-data el "hs-active" false)
(dom-set-data el "hs-script" nil))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define
hs-boot!
(fn
@@ -88,10 +111,6 @@
((elements (dom-query-all (host-get (host-global "document") "body") "[_]")))
(for-each (fn (el) (hs-activate! el)) elements))))
;; ── Boot subtree: for dynamic content ───────────────────────────
;; Called after HTMX swaps or dynamic DOM insertion.
;; Only activates elements within the given root.
(define
hs-boot-subtree!
(fn

166
shared/static/wasm/sx/hs-parser.sx
View File

@@ -550,6 +550,14 @@
(quote and)
(list (quote >=) left lo)
(list (quote <=) left hi))))))
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
(let
((type-name (tp-val)))
(do
(adv!)
(list
(quote not)
(list (quote type-check) left type-name)))))
(true
(let
((right (parse-expr)))
@@ -566,6 +574,10 @@
(quote and)
(list (quote >=) left lo)
(list (quote <=) left hi)))))
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
(let
((type-name (tp-val)))
(do (adv!) (list (quote type-check) left type-name))))
(true
(let
((right (parse-expr)))
@@ -596,7 +608,7 @@
(match-kw "case")
(list (quote ends-with-ic?) left rhs))
(list (quote ends-with?) left rhs)))))
((and (= typ "keyword") (= val "matches"))
((and (= typ "keyword") (or (= val "matches") (= val "match")))
(do
(adv!)
(let
@@ -638,7 +650,22 @@
(quote as)
left
(str type-name ":" param)))))
(list (quote as) left type-name))))))
(let
loop
((result (list (quote as) left type-name)))
(if
(and (= (tp-type) "op") (= (tp-val) "|"))
(do
(adv!)
(when
(or (= (tp-val) "a") (= (tp-val) "an"))
(adv!))
(let
((next-type (tp-val)))
(do
(adv!)
(loop (list (quote as) result next-type)))))
result)))))))
((and (= typ "colon"))
(do
(adv!)
@@ -713,7 +740,7 @@
(list (quote strict-eq) left (parse-expr))))
((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes")))
(do (adv!) (list (quote contains?) left (parse-expr))))
((and (= typ "keyword") (= val "precedes"))
((and (= typ "keyword") (or (= val "precedes") (= val "precede")))
(do (adv!) (list (quote precedes?) left (parse-atom))))
((and (= typ "keyword") (= val "follows"))
(do (adv!) (list (quote follows?) left (parse-atom))))
@@ -792,7 +819,7 @@
(= (tp-val) "starts")
(= (tp-val) "ends")
(= (tp-val) "contains")
(= (tp-val) "matches")
(or (= (tp-val) "matches") (= (tp-val) "match"))
(= (tp-val) "is")
(= (tp-val) "does")
(= (tp-val) "in")
@@ -1082,38 +1109,67 @@
(match-kw "between")
(let
((val1 (parse-atom)))
(expect-kw! "and")
(let
((val2 (parse-atom)))
(do
(when (= (tp-type) "comma") (adv!))
(if
(match-kw "and")
(let
((val3 (parse-atom)))
(if
(match-kw "and")
(and (= (tp-type) "keyword") (= (tp-val) "and"))
(adv!)
nil)
(let
((val2 (parse-atom)))
(if
(or
(= (tp-type) "comma")
(and
(= (tp-type) "keyword")
(= (tp-val) "and")))
(do
(when (= (tp-type) "comma") (adv!))
(if
(and
(= (tp-type) "keyword")
(= (tp-val) "and"))
(adv!)
nil)
(let
((val4 (parse-atom)))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3
val4))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3)))
(list
(quote toggle-style-between)
prop
val1
val2
tgt))))
((val3 (parse-atom)))
(if
(or
(= (tp-type) "comma")
(and
(= (tp-type) "keyword")
(= (tp-val) "and")))
(do
(when (= (tp-type) "comma") (adv!))
(if
(and
(= (tp-type) "keyword")
(= (tp-val) "and"))
(adv!)
nil)
(let
((val4 (parse-atom)))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3
val4)))
(list
(quote toggle-style-cycle)
prop
tgt
val1
val2
val3))))
(list
(quote toggle-style-between)
prop
val1
val2
tgt)))))
(list (quote toggle-style) prop tgt)))))
((= (tp-type) "attr")
(let
@@ -1422,7 +1478,7 @@
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
(let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
(list (quote hide) tgt strategy when-cond))))))
@@ -1433,7 +1489,7 @@
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
(let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (adv!) s)) "display")))
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
(list (quote show) tgt strategy when-cond))))))
@@ -1648,7 +1704,9 @@
(let
((n (parse-atom)))
(do
(expect-kw! "of")
(if
(not (or (match-kw "of") (match-kw "from")))
(error (str "Expected 'of' or 'from' at position " p)))
(let
((coll (parse-expr)))
(list (quote pick-first) coll n))))))
@@ -1658,7 +1716,9 @@
(let
((n (parse-atom)))
(do
(expect-kw! "of")
(if
(not (or (match-kw "of") (match-kw "from")))
(error (str "Expected 'of' or 'from' at position " p)))
(let
((coll (parse-expr)))
(list (quote pick-last) coll n))))))
@@ -1666,14 +1726,17 @@
(do
(adv!)
(if
(match-kw "of")
(or (match-kw "of") (match-kw "from"))
(let
((coll (parse-expr)))
(list (quote pick-random) coll nil))
(let
((n (parse-atom)))
(do
(expect-kw! "of")
(if
(not (or (match-kw "of") (match-kw "from")))
(error
(str "Expected 'of' or 'from' at position " p)))
(let
((coll (parse-expr)))
(list (quote pick-random) coll n)))))))
@@ -1687,7 +1750,10 @@
(let
((end-expr (parse-atom)))
(do
(expect-kw! "of")
(if
(not (or (match-kw "of") (match-kw "from")))
(error
(str "Expected 'of' or 'from' at position " p)))
(let
((coll (parse-expr)))
(list (quote pick-items) coll start-expr end-expr))))))))
@@ -1727,10 +1793,26 @@
(let
((haystack (parse-expr)))
(list (quote pick-matches) regex haystack))))))
((and (= typ "ident") (= val "item"))
(do
(adv!)
(let
((n (parse-expr)))
(do
(if
(not (or (match-kw "of") (match-kw "from")))
(error (str "Expected 'of' or 'from' at position " p)))
(let
((coll (parse-expr)))
(list
(quote pick-items)
coll
n
(list (quote +) n 1)))))))
(true
(error
(str
"Expected first/last/random/items/match/matches after 'pick' at "
"Expected first/last/random/item/items/match/matches after 'pick' at "
p)))))))
(define
parse-go-cmd

88
shared/static/wasm/sx/hs-runtime.sx
View File

@@ -94,7 +94,7 @@
((or (= prop "display") (= prop "opacity"))
(if
(or (= cur "none") (= cur "0"))
(dom-set-style target prop (if (= prop "opacity") "1" ""))
(dom-set-style target prop (if (= prop "opacity") "1" "block"))
(dom-set-style target prop (if (= prop "display") "none" "0"))))
(true
(if
@@ -821,11 +821,26 @@
((nil? suffix) false)
(true (ends-with? (str s) (str suffix))))))
(define
hs-scoped-set!
(fn (el name val) (dom-set-data el (str "hs-local-" name) val)))
(define
hs-scoped-get
(fn (el name) (dom-get-data el (str "hs-local-" name))))
(define
hs-precedes?
(fn
(a b)
(cond ((nil? a) false) ((nil? b) false) (true (< (str a) (str b))))))
(cond
((nil? a) false)
((nil? b) false)
((and (dict? a) (dict? b))
(let
((pos (host-call a "compareDocumentPosition" b)))
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
(true (< (str a) (str b))))))
(define
hs-follows?
@@ -916,7 +931,18 @@
(= obj (nth r 1))
(= obj nil)))))))
(define precedes? (fn (a b) (< (str a) (str b))))
(define
precedes?
(fn
(a b)
(cond
((nil? a) false)
((nil? b) false)
((and (dict? a) (dict? b))
(let
((pos (host-call a "compareDocumentPosition" b)))
(if (number? pos) (not (= 0 (mod (/ pos 4) 2))) false)))
(true (< (str a) (str b))))))
(define
hs-empty?
@@ -1206,15 +1232,23 @@
(fn
(el strategy)
(let
((tag (dom-get-prop el "tagName")))
(cond
((= tag "DIALOG")
(when (dom-has-attr? el "open") (host-call el "close")))
((= tag "DETAILS") (dom-set-prop el "open" false))
((= strategy "opacity") (dom-set-style el "opacity" "0"))
((= strategy "visibility")
(dom-set-style el "visibility" "hidden"))
(true (dom-set-style el "display" "none"))))))
((parts (split strategy ":")) (tag (dom-get-prop el "tagName")))
(let
((prop (first parts))
(val (if (> (len parts) 1) (nth parts 1) nil)))
(cond
((= tag "DIALOG")
(when (dom-has-attr? el "open") (host-call el "close")))
((= tag "DETAILS") (dom-set-prop el "open" false))
((= prop "opacity")
(dom-set-style el "opacity" (if val val "0")))
((= prop "visibility")
(dom-set-style el "visibility" (if val val "hidden")))
((= prop "hidden") (dom-set-attr el "hidden" ""))
((= prop "twDisplay") (dom-add-class el "hidden"))
((= prop "twVisibility") (dom-add-class el "invisible"))
((= prop "twOpacity") (dom-add-class el "opacity-0"))
(true (dom-set-style el "display" (if val val "none"))))))))
(define
hs-hide!
(fn
@@ -1230,17 +1264,25 @@
(fn
(el strategy)
(let
((tag (dom-get-prop el "tagName")))
(cond
((= tag "DIALOG")
(when
(not (dom-has-attr? el "open"))
(host-call el "showModal")))
((= tag "DETAILS") (dom-set-prop el "open" true))
((= strategy "opacity") (dom-set-style el "opacity" "1"))
((= strategy "visibility")
(dom-set-style el "visibility" "visible"))
(true (dom-set-style el "display" ""))))))
((parts (split strategy ":")) (tag (dom-get-prop el "tagName")))
(let
((prop (first parts))
(val (if (> (len parts) 1) (nth parts 1) nil)))
(cond
((= tag "DIALOG")
(when
(not (dom-has-attr? el "open"))
(host-call el "showModal")))
((= tag "DETAILS") (dom-set-prop el "open" true))
((= prop "opacity")
(dom-set-style el "opacity" (if val val "1")))
((= prop "visibility")
(dom-set-style el "visibility" (if val val "visible")))
((= prop "hidden") (dom-remove-attr el "hidden"))
((= prop "twDisplay") (dom-remove-class el "hidden"))
((= prop "twVisibility") (dom-remove-class el "invisible"))
((= prop "twOpacity") (dom-remove-class el "opacity-0"))
(true (dom-set-style el "display" (if val val "block"))))))))
(define
hs-show!
(fn

4
shared/static/wasm/sx/hs-tokenizer.sx
View File

@@ -436,6 +436,8 @@
(let
((ch (hs-cur)) (start pos))
(cond
(and (= ch "-") (< (+ pos 1) src-len) (= (hs-peek 1) "-"))
(do (hs-advance! 2) (skip-comment!) (scan!))
(and (= ch "/") (< (+ pos 1) src-len) (= (hs-peek 1) "/"))
(do (hs-advance! 2) (skip-comment!) (scan!))
(and
@@ -613,6 +615,8 @@
(do (hs-emit! "op" "\\" start) (hs-advance! 1) (scan!))
(= ch ":")
(do (hs-emit! "colon" ":" start) (hs-advance! 1) (scan!))
(= ch "|")
(do (hs-emit! "op" "|" start) (hs-advance! 1) (scan!))
:else (do (hs-advance! 1) (scan!)))))))
(scan!)
(hs-emit! "eof" nil pos)