HS: count-filtered events + first modifier (+5 tests)
Parser: parse-on-feat now consumes `first` keyword before event-name (sets
count-min/max to 1) and a count expression after event-name — `N` (single),
`N to M` (range), `N and on` (unbounded above). Number tokens are coerced
via parse-number. Emits :count-filter {"min" N "max" M | -1} part.
Compiler: scan-on threads count-filter-info; the handler binding wraps the
fn body in a let-bound __hs-count counter. Each event fire increments the
counter and (when count is in range) executes the original body. Each
on-clause registers an independent handler with its own counter, so
`on click 1 ... on click 2 ... on click 3` produces three handlers that
fire on their respective Nth click (mix-ranges test).
Generator: dropped 5 cluster-34 tests from skip-list — `can filter events
based on count`, `... count range`, `... unbounded count range`, `can mix
ranges`, `on first click fires only once`.
hs-upstream-on: 43/70 → 48/70. Smoke 0-195 unchanged at 172/195.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -2601,70 +2601,74 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((every? (match-kw "every")))
|
||||
((every? (match-kw "every")) (first? (match-kw "first")))
|
||||
(let
|
||||
((event-name (parse-compound-event-name)))
|
||||
(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)))))
|
||||
((count-filter (let ((mn nil) (mx nil)) (when first? (do (set! mn 1) (set! mx 1))) (when (= (tp-type) "number") (let ((n (parse-number (tp-val)))) (do (adv!) (set! mn n) (cond ((match-kw "to") (cond ((= (tp-type) "number") (let ((mv (parse-number (tp-val)))) (do (adv!) (set! mx mv)))) (true (set! mx n)))) ((match-kw "and") (cond ((match-kw "on") (set! mx -1)) (true (set! mx n)))) (true (set! mx n)))))) (if mn (dict "min" mn "max" mx) nil))))
|
||||
(let
|
||||
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
|
||||
((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
|
||||
((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!)
|
||||
((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!)
|
||||
(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 source (append parts (list :from source)) parts)))
|
||||
((parts (if flt (append parts (list :filter flt)) parts)))
|
||||
(let
|
||||
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
|
||||
((parts (if source (append parts (list :from source)) parts)))
|
||||
(let
|
||||
((parts (if having (append parts (list :having having)) parts)))
|
||||
((parts (if count-filter (append parts (list :count-filter count-filter)) parts)))
|
||||
(let
|
||||
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
||||
((parts (if of-filter (append parts (list :of-filter of-filter)) parts)))
|
||||
(let
|
||||
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
||||
((parts (if having (append parts (list :having having)) parts)))
|
||||
(let
|
||||
((parts (append parts (list body))))
|
||||
parts))))))))))))))))))))
|
||||
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
||||
(let
|
||||
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
||||
(let
|
||||
((parts (append parts (list body))))
|
||||
parts))))))))))))))))))))))
|
||||
(define
|
||||
parse-init-feat
|
||||
(fn
|
||||
|
||||
Reference in New Issue
Block a user