HS: extend parser/runtime + new node test runner; ignore test-results/

- Parser: `--` line comments, `|` op, `result` → `the-result`, query-scoped
  `<sel> in <expr>`, `is a/an <type>` predicate, multi-`as` chaining with `|`,
  `match`/`precede` keyword aliases, `[attr]` add/toggle, between attr forms
- Runtime: per-element listener registry + hs-deactivate!, attr toggle
  variants, set-inner-html boots subtree, hs-append polymorphic on
  string/list/element, default? / array-set! / query-all-in / list-set
  via take+drop, hs-script idempotence guard
- Integration: skip reserved (me/it/event/you/yourself) when collecting vars
- Tokenizer: emit `--` comments and `|` op
- Test framework + conformance runner updates; new tests/hs-run-filtered.js
  (single-process Node runner using OCaml VM step-limit to bound infinite
  loops); generate-sx-conformance-dev.py improvements
- mcp_tree.ml + run_tests.ml: harness extensions
- .gitignore: top-level test-results/ (Playwright artifacts)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-23 07:11:07 +00:00
parent b2ae80fb21
commit 0515295317
20 changed files with 15224 additions and 8120 deletions

View File

@@ -85,18 +85,18 @@
(nth target 1)
value))
((= th (quote me))
(list (quote dom-set-inner-html) (quote me) value))
(list (quote hs-set-inner-html!) (quote me) value))
((= th (quote it)) (list (quote set!) (quote it) value))
((= th (quote query))
(list (quote dom-set-inner-html) (hs-to-sx target) value))
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
((= th (quote array-index))
(list
(quote host-set!)
(quote hs-array-set!)
(hs-to-sx (nth target 1))
(hs-to-sx (nth target 2))
value))
((or (= th (quote next)) (= th (quote previous)) (= th (quote closest)))
(list (quote dom-set-inner-html) (hs-to-sx target) value))
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
((= th (quote of))
(let
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
@@ -162,10 +162,19 @@
(let
((wrapped-body (if catch-info (let ((var (make-symbol (nth catch-info 0))) (catch-body (hs-to-sx (nth catch-info 1)))) (if finally-info (list (quote do) (list (quote guard) (list var (list true catch-body)) compiled-body) (hs-to-sx finally-info)) (list (quote guard) (list var (list true catch-body)) compiled-body))) (if finally-info (list (quote do) compiled-body (hs-to-sx finally-info)) compiled-body)))
(handler
(list
(quote fn)
(list (quote event))
wrapped-body)))
(let
((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false)))))
(list
(quote fn)
(list (quote event))
(if
(uses-the-result? wrapped-body)
(list
(quote let)
(list
(list (quote the-result) nil))
wrapped-body)
wrapped-body)))))
(if
every?
(list
@@ -443,9 +452,7 @@
(quote __hs-new)
(list
(quote +)
(list
(quote hs-to-number)
(list (quote nth) var-sym (quote __hs-idx)))
(list (quote nth) var-sym (quote __hs-idx))
amount)))
(list
(quote do)
@@ -463,10 +470,7 @@
((t (hs-to-sx expr)))
(list
(quote let)
(list
(list
(quote __hs-new)
(list (quote +) (list (quote hs-to-number) t) amount)))
(list (list (quote __hs-new) (list (quote +) t amount)))
(list
(quote do)
(list (quote set!) t (quote __hs-new))
@@ -564,9 +568,7 @@
(quote __hs-new)
(list
(quote -)
(list
(quote hs-to-number)
(list (quote nth) var-sym (quote __hs-idx)))
(list (quote nth) var-sym (quote __hs-idx))
amount)))
(list
(quote do)
@@ -584,10 +586,7 @@
((t (hs-to-sx expr)))
(list
(quote let)
(list
(list
(quote __hs-new)
(list (quote -) (list (quote hs-to-number) t) amount)))
(list (list (quote __hs-new) (list (quote -) t amount)))
(list
(quote do)
(list (quote set!) t (quote __hs-new))
@@ -870,6 +869,11 @@
((= head (quote ref)) (make-symbol (nth ast 1)))
((= head (quote query))
(list (quote hs-query-first) (nth ast 1)))
((= head (quote query-scoped))
(list
(quote hs-query-all-in)
(nth ast 1)
(hs-to-sx (nth ast 2))))
((= head (quote attr))
(list
(quote dom-get-attr)
@@ -1163,6 +1167,14 @@
(quote set!)
(hs-to-sx tgt)
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
((= head (quote add-attr))
(let
((tgt (nth ast 3)))
(list
(quote hs-set-attr!)
(hs-to-sx tgt)
(nth ast 1)
(hs-to-sx (nth ast 2)))))
((= head (quote remove-value))
(let
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
@@ -1296,6 +1308,20 @@
(nth ast 1)
(hs-to-sx (nth ast 2))
(hs-to-sx (nth ast 3))))
((= head (quote toggle-attr-val))
(list
(quote hs-toggle-attr-val!)
(hs-to-sx (nth ast 3))
(nth ast 1)
(hs-to-sx (nth ast 2))))
((= head (quote toggle-attr-diff))
(list
(quote hs-toggle-attr-diff!)
(hs-to-sx (nth ast 5))
(nth ast 1)
(hs-to-sx (nth ast 2))
(nth ast 3)
(hs-to-sx (nth ast 4))))
((= head (quote set!))
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
((= head (quote put!))
@@ -1359,13 +1385,48 @@
((= head (quote hide))
(let
((tgt (hs-to-sx (nth ast 1)))
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
(list (quote hs-hide!) tgt strategy)))
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(if
(nil? when-cond)
(list (quote hs-hide!) tgt strategy)
(list
(quote hs-hide-when!)
tgt
strategy
(list
(quote fn)
(list (quote it))
(hs-to-sx when-cond))))))
((= head (quote show))
(let
((tgt (hs-to-sx (nth ast 1)))
(strategy (if (> (len ast) 2) (nth ast 2) "display")))
(list (quote hs-show!) tgt strategy)))
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
(if
(nil? when-cond)
(list (quote hs-show!) tgt strategy)
(list
(quote let)
(list
(list
(quote __hs-show-r)
(list
(quote hs-show-when!)
tgt
strategy
(list
(quote fn)
(list (quote it))
(hs-to-sx when-cond)))))
(list
(quote begin)
(list
(quote set!)
(quote the-result)
(quote __hs-show-r))
(list (quote set!) (quote it) (quote __hs-show-r))
(quote __hs-show-r))))))
((= head (quote transition)) (emit-transition ast))
((= head (quote transition-from))
(let
@@ -1424,6 +1485,14 @@
(list (quote hs-settle) (quote me)))
((= head (quote go))
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
((= head (quote __get-cmd))
(let
((val (hs-to-sx (nth ast 1))))
(list
(quote begin)
(list (quote set!) (quote the-result) val)
(list (quote set!) (quote it) val)
val)))
((= head (quote append!))
(let
((tgt (hs-to-sx (nth ast 2)))
@@ -1648,11 +1717,13 @@
(list (quote hs-reset!) (hs-to-sx (nth ast 1))))
((= head (quote default!))
(let
((t (hs-to-sx (nth ast 1))) (v (hs-to-sx (nth ast 2))))
((tgt-ast (nth ast 1))
(read (hs-to-sx (nth ast 1)))
(v (hs-to-sx (nth ast 2))))
(list
(quote when)
(list (quote nil?) t)
(list (quote set!) t v))))
(list (quote hs-default?) read)
(emit-set tgt-ast v))))
((= head (quote hs-is))
(list
(quote hs-is)

View File

@@ -16,6 +16,14 @@
(fn
(sx)
(define vars (list))
(define
reserved
(list
(quote me)
(quote it)
(quote event)
(quote you)
(quote yourself)))
(define
walk
(fn
@@ -30,7 +38,9 @@
(let
((name (nth node 1)))
(when
(not (some (fn (v) (= v name)) vars))
(and
(not (some (fn (v) (= v name)) vars))
(not (some (fn (v) (= v name)) reserved)))
(set! vars (cons name vars)))))
(for-each walk node))))
(walk sx)

View File

@@ -95,6 +95,13 @@
(do (adv!) (list kind (str "." val) (list (quote me)))))
((= typ "id")
(do (adv!) (list kind (str "#" val) (list (quote me)))))
((= typ "attr")
(do
(adv!)
(list
(quote attr)
val
(list kind (str "[" val "]") (list (quote me))))))
(true (list kind "*" (list (quote me))))))))
(define
parse-pos-kw
@@ -146,8 +153,10 @@
(do (adv!) (list (quote me))))
((and (= typ "keyword") (= val "I"))
(do (adv!) (list (quote me))))
((and (= typ "keyword") (or (= val "it") (= val "result")))
((and (= typ "keyword") (= val "it"))
(do (adv!) (list (quote it))))
((and (= typ "keyword") (= val "result"))
(do (adv!) (quote the-result)))
((and (= typ "keyword") (= val "event"))
(do (adv!) (list (quote event))))
((and (= typ "keyword") (= val "target"))
@@ -174,7 +183,18 @@
(do (adv!) (parse-pos-kw (quote last))))
((= typ "id")
(do (adv!) (list (quote query) (str "#" val))))
((= typ "selector") (do (adv!) (list (quote query) val)))
((= typ "selector")
(do
(adv!)
(if
(and (= (tp-type) "keyword") (= (tp-val) "in"))
(do
(adv!)
(list
(quote query-scoped)
val
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))))
((= typ "attr")
(do (adv!) (list (quote attr) val (list (quote me)))))
((= typ "style")
@@ -426,7 +446,7 @@
(list (quote type-check) left type-name)))))))
(true
(let
((right (parse-expr)))
((right (parse-cmp (parse-arith (parse-poss (parse-atom))))))
(if
(match-kw "ignoring")
(do
@@ -892,6 +912,18 @@
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
(list (quote set-styles) (reverse pairs) tgt)))))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do
(adv!)
(let
((attr-name (get (adv!) "value")))
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
(let
((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
(list (quote add-attr) attr-name attr-val tgt))))))
(true
(let
((value (parse-expr)))
@@ -978,20 +1010,58 @@
()
(cond
((match-kw "between")
(if
(= (tp-type) "class")
(let
((cls1 (do (let ((v (tp-val))) (adv!) v))))
(expect-kw! "and")
(if
(= (tp-type) "class")
(let
((cls2 (do (let ((v (tp-val))) (adv!) v))))
(cond
((= (tp-type) "class")
(let
((cls1 (do (let ((v (tp-val))) (adv!) v))))
(expect-kw! "and")
(if
(= (tp-type) "class")
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-between) cls1 cls2 tgt)))
nil))
nil))
((cls2 (do (let ((v (tp-val))) (adv!) v))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-between) cls1 cls2 tgt)))
nil)))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do
(adv!)
(let
((n1 (get (adv!) "value")))
(when
(and (= (tp-type) "op") (= (tp-val) "="))
(adv!))
(let
((v1 (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(expect-kw! "and")
(when (= (tp-type) "bracket-open") (adv!))
(let
((n2 (get (adv!) "value")))
(when
(and (= (tp-type) "op") (= (tp-val) "="))
(adv!))
(let
((v2 (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(if
(= n1 n2)
(list
(quote toggle-attr-between)
n1
v1
v2
tgt)
(list
(quote toggle-attr-diff)
n1
v1
n2
v2
tgt)))))))))
(true nil)))
((= (tp-type) "class")
(let
((cls (do (let ((v (tp-val))) (adv!) v))))
@@ -1064,6 +1134,18 @@
val2
tgt)))
(list (quote toggle-attr) attr-name tgt)))))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do
(adv!)
(let
((attr-name (get (adv!) "value")))
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
(let
((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do
(adv!)
@@ -1338,19 +1420,23 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (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)))))
((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")))
(list (quote hide) tgt strategy)))))
(let
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
(list (quote hide) tgt strategy when-cond))))))
(define
parse-show-cmd
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (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)))))
((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")))
(list (quote show) tgt strategy)))))
(let
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
(list (quote show) tgt strategy when-cond))))))
(define
parse-transition-cmd
(fn
@@ -1493,7 +1579,7 @@
(ca-collect (append acc (list arg)))))))
(ca-collect (list))))
(define parse-call-cmd (fn () (parse-expr)))
(define parse-get-cmd (fn () (parse-expr)))
(define parse-get-cmd (fn () (list (quote __get-cmd) (parse-expr))))
(define
parse-take-cmd
(fn
@@ -1501,12 +1587,34 @@
(cond
((= (tp-type) "class")
(let
((cls (do (let ((v (tp-val))) (adv!) v))))
((classes (list)))
(let
((from-sel (if (match-kw "from") (parse-expr) nil)))
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
(collect)
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(list (quote take!) "class" cls from-sel for-tgt)))))
((from-sel (if (match-kw "from") (parse-expr) nil)))
(let
((for-tgt (if (match-kw "for") (parse-expr) nil)))
(if
(= (len classes) 1)
(list
(quote take!)
"class"
(first classes)
from-sel
for-tgt)
(cons
(quote do)
(map
(fn
(cls)
(list
(quote take!)
"class"
cls
from-sel
for-tgt))
classes))))))))
((= (tp-type) "attr")
(let
((attr-name (get (adv!) "value")))
@@ -1588,7 +1696,7 @@
(adv!)
(expect-kw! "of")
(let
((regex (parse-expr)))
((regex (parse-atom)))
(do
(cond
((match-kw "of") nil)
@@ -1606,7 +1714,7 @@
(adv!)
(expect-kw! "of")
(let
((regex (parse-expr)))
((regex (parse-atom)))
(do
(cond
((match-kw "of") nil)
@@ -1697,7 +1805,7 @@
(match-kw "of")
(list (make-symbol ".") (parse-expr) val)
(cond
((= val "result") (list (quote it)))
((= val "result") (quote the-result))
((= val "first") (parse-pos-kw (quote first)))
((= val "last") (parse-pos-kw (quote last)))
((= val "closest") (parse-trav (quote closest)))

File diff suppressed because it is too large Load Diff