HS: on-suite parser fixes (+5 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 6m42s

- parse-halt-cmd: after consuming 'the event's', check for 'bubbling'
  token and return "bubbling" mode instead of "the-event"
- parse-wait-cmd: skip article words (a/an/the) before reading event
  name, so 'wait for a customEvent' works correctly
- parse-on-feat: parse optional (vars) paren group before flt and
  consume-having!, so 'on intersection(intersecting) having ...' works;
  inject event-var refs into body for compiler's event-refs mechanism

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-05-04 15:02:21 +00:00
parent 73e86fa8e8
commit f4ef4033de
2 changed files with 112 additions and 108 deletions

View File

@@ -1573,7 +1573,7 @@
(cond
((match-kw "for")
(let
((event-name (tp-val)))
((event-name (do (when (or (= (tp-val) "a") (= (tp-val) "an") (= (tp-val) "the")) (adv!)) (tp-val))))
(adv!)
(let
((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil)))
@@ -2428,7 +2428,7 @@
(fn
()
(let
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) "the-event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) (if (= (tp-val) "bubbling") (do (adv!) "bubbling") "the-event"))) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
(list (quote halt!) mode))))
(define
parse-param-list
@@ -2918,74 +2918,76 @@
(let
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil)))))
(let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
((event-vars (if (= (tp-type) "paren-open") (do (adv!) (define ev-coll (fn () (cond ((or (= (tp-type) "paren-close") (= (tp-type) "eof")) (do (when (= (tp-type) "paren-close") (adv!)) (list))) ((or (= (tp-type) "ident") (= (tp-type) "keyword")) (let ((nm (tp-val))) (adv!) (cons nm (ev-coll)))) (true (do (adv!) (ev-coll)))))) (ev-coll)) (list))))
(let
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false)))
(source (if (match-kw "from") (parse-expr) nil)))
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(when
(and
(= (tp-type) "keyword")
(= (tp-val) "queue"))
(do (adv!) (adv!)))
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false)))
(source (if (match-kw "from") (parse-expr) nil)))
(let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(when
(and
(= (tp-type) "keyword")
(= (tp-val) "queue"))
(do (adv!) (adv!)))
(let
((body (parse-cmd-list)))
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
((body (parse-cmd-list)))
(let
((parts (list (quote on) event-name)))
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let
((parts (if every? (append parts (list :every true)) parts)))
((parts (list (quote on) event-name)))
(let
((parts (if flt (append parts (list :filter flt)) parts)))
((parts (if every? (append parts (list :every true)) parts)))
(let
((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
((parts (if flt (append parts (list :filter flt)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
(let
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
((parts (if source (append parts (list :from source)) parts)))
(let
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
(let
((parts (if having (append parts (list :having having)) parts)))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
((parts (if having (append parts (list :having having)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let
((parts (append parts (list body))))
parts)))))))))))))))))))))))
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let
((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
parts))))))))))))))))))))))))
(define
parse-init-feat
(fn

View File

@@ -1573,7 +1573,7 @@
(cond
((match-kw "for")
(let
((event-name (tp-val)))
((event-name (do (when (or (= (tp-val) "a") (= (tp-val) "an") (= (tp-val) "the")) (adv!)) (tp-val))))
(adv!)
(let
((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil)))
@@ -2428,7 +2428,7 @@
(fn
()
(let
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) "the-event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) (if (= (tp-val) "bubbling") (do (adv!) "bubbling") "the-event"))) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
(list (quote halt!) mode))))
(define
parse-param-list
@@ -2918,74 +2918,76 @@
(let
((of-filter (when (and (= event-name "mutation") (match-kw "of")) (cond ((and (= (tp-type) "ident") (or (= (tp-val) "attributes") (= (tp-val) "childList") (= (tp-val) "characterData"))) (let ((nm (tp-val))) (do (adv!) (dict "type" nm)))) ((= (tp-type) "attr") (let ((attrs (list (tp-val)))) (do (adv!) (define collect-or! (fn () (when (match-kw "or") (cond ((= (tp-type) "attr") (do (set! attrs (append attrs (list (tp-val)))) (adv!) (collect-or!))) (true (set! p (- p 1))))))) (collect-or!) (dict "type" "attrs" "attrs" attrs)))) (true nil)))))
(let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
((event-vars (if (= (tp-type) "paren-open") (do (adv!) (define ev-coll (fn () (cond ((or (= (tp-type) "paren-close") (= (tp-type) "eof")) (do (when (= (tp-type) "paren-close") (adv!)) (list))) ((or (= (tp-type) "ident") (= (tp-type) "keyword")) (let ((nm (tp-val))) (adv!) (cons nm (ev-coll)))) (true (do (adv!) (ev-coll)))))) (ev-coll)) (list))))
(let
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false)))
(source (if (match-kw "from") (parse-expr) nil)))
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
(let
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(when
(and
(= (tp-type) "keyword")
(= (tp-val) "queue"))
(do (adv!) (adv!)))
((elsewhere? (cond ((match-kw "elsewhere") true) ((and (= (tp-type) "keyword") (= (tp-val) "from") (let ((nxt (if (< (+ p 1) tok-len) (nth tokens (+ p 1)) nil))) (and nxt (= (get nxt "type") "keyword") (= (get nxt "value") "elsewhere")))) (do (adv!) (adv!) true)) (true false)))
(source (if (match-kw "from") (parse-expr) nil)))
(let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
((h-margin nil) (h-threshold nil))
(define
consume-having!
(fn
()
(cond
((and (= (tp-type) "ident") (= (tp-val) "having"))
(do
(adv!)
(cond
((and (= (tp-type) "ident") (= (tp-val) "margin"))
(do
(adv!)
(set! h-margin (parse-expr))
(consume-having!)))
((and (= (tp-type) "ident") (= (tp-val) "threshold"))
(do
(adv!)
(set! h-threshold (parse-expr))
(consume-having!)))
(true nil))))
(true nil))))
(consume-having!)
(when
(and
(= (tp-type) "keyword")
(= (tp-val) "queue"))
(do (adv!) (adv!)))
(let
((body (parse-cmd-list)))
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(let
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
((body (parse-cmd-list)))
(let
((parts (list (quote on) event-name)))
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
(finally-clause
(if
(match-kw "finally")
(parse-cmd-list)
nil)))
(match-kw "end")
(let
((parts (if every? (append parts (list :every true)) parts)))
((parts (list (quote on) event-name)))
(let
((parts (if flt (append parts (list :filter flt)) parts)))
((parts (if every? (append parts (list :every true)) parts)))
(let
((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
((parts (if flt (append parts (list :filter flt)) parts)))
(let
((parts (if source (append parts (list :from source)) parts)))
((parts (if elsewhere? (append parts (list :elsewhere true)) parts)))
(let
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
((parts (if source (append parts (list :from source)) parts)))
(let
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
(let
((parts (if having (append parts (list :having having)) parts)))
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
(let
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
((parts (if having (append parts (list :having having)) parts)))
(let
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
(let
((parts (append parts (list body))))
parts)))))))))))))))))))))))
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
(let
((parts (append parts (list (if (> (len event-vars) 0) (cons (quote do) (append (map (fn (nm) (list (quote ref) nm)) event-vars) (if (and (list? body) (= (first body) (quote do))) (rest body) (list body)))) body)))))
parts))))))))))))))))))))))))
(define
parse-init-feat
(fn