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:
2026-04-25 12:08:40 +00:00
parent ff38499bd5
commit 19c97989d7
6 changed files with 195 additions and 122 deletions

View File

@@ -165,7 +165,8 @@
catch-info
finally-info
having-info
of-filter-info)
of-filter-info
count-filter-info)
(cond
((<= (len items) 1)
(let
@@ -183,7 +184,7 @@
(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))))
(let
((handler (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)))))
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (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 count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler)))))
(let
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
(cond
@@ -233,7 +234,8 @@
catch-info
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :filter)
(scan-on
(rest (rest items))
@@ -243,7 +245,8 @@
catch-info
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :every)
(scan-on
(rest (rest items))
@@ -253,7 +256,8 @@
catch-info
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :catch)
(scan-on
(rest (rest items))
@@ -263,7 +267,8 @@
(nth items 1)
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :finally)
(scan-on
(rest (rest items))
@@ -273,7 +278,8 @@
catch-info
(nth items 1)
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :having)
(scan-on
(rest (rest items))
@@ -283,7 +289,8 @@
catch-info
finally-info
(nth items 1)
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :of-filter)
(scan-on
(rest (rest items))
@@ -293,6 +300,18 @@
catch-info
finally-info
having-info
(nth items 1)
count-filter-info))
((= (first items) :count-filter)
(scan-on
(rest (rest items))
source
filter
every?
catch-info
finally-info
having-info
of-filter-info
(nth items 1)))
(true
(scan-on
@@ -303,8 +322,9 @@
catch-info
finally-info
having-info
of-filter-info)))))
(scan-on (rest parts) nil nil false nil nil nil nil)))))
of-filter-info
count-filter-info)))))
(scan-on (rest parts) nil nil false nil nil nil nil nil)))))
(define
emit-send
(fn

View File

@@ -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

View File

@@ -165,7 +165,8 @@
catch-info
finally-info
having-info
of-filter-info)
of-filter-info
count-filter-info)
(cond
((<= (len items) 1)
(let
@@ -183,7 +184,7 @@
(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))))
(let
((handler (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)))))
((handler (let ((uses-the-result? (fn (expr) (cond ((= expr (quote the-result)) true) ((list? expr) (some (fn (x) (uses-the-result? x)) expr)) (true false))))) (let ((base-handler (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 count-filter-info (let ((mn (get count-filter-info "min")) (mx (get count-filter-info "max"))) (list (quote let) (list (list (quote __hs-count) 0)) (list (quote fn) (list (quote event)) (list (quote begin) (list (quote set!) (quote __hs-count) (list (quote +) (quote __hs-count) 1)) (list (quote when) (if (= mx -1) (list (quote >=) (quote __hs-count) mn) (list (quote and) (list (quote >=) (quote __hs-count) mn) (list (quote <=) (quote __hs-count) mx))) (nth base-handler 2)))))) base-handler)))))
(let
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
(cond
@@ -233,7 +234,8 @@
catch-info
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :filter)
(scan-on
(rest (rest items))
@@ -243,7 +245,8 @@
catch-info
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :every)
(scan-on
(rest (rest items))
@@ -253,7 +256,8 @@
catch-info
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :catch)
(scan-on
(rest (rest items))
@@ -263,7 +267,8 @@
(nth items 1)
finally-info
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :finally)
(scan-on
(rest (rest items))
@@ -273,7 +278,8 @@
catch-info
(nth items 1)
having-info
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :having)
(scan-on
(rest (rest items))
@@ -283,7 +289,8 @@
catch-info
finally-info
(nth items 1)
of-filter-info))
of-filter-info
count-filter-info))
((= (first items) :of-filter)
(scan-on
(rest (rest items))
@@ -293,6 +300,18 @@
catch-info
finally-info
having-info
(nth items 1)
count-filter-info))
((= (first items) :count-filter)
(scan-on
(rest (rest items))
source
filter
every?
catch-info
finally-info
having-info
of-filter-info
(nth items 1)))
(true
(scan-on
@@ -303,8 +322,9 @@
catch-info
finally-info
having-info
of-filter-info)))))
(scan-on (rest parts) nil nil false nil nil nil nil)))))
of-filter-info
count-filter-info)))))
(scan-on (rest parts) nil nil false nil nil nil nil nil)))))
(define
emit-send
(fn

View File

@@ -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

View File

@@ -8820,11 +8820,29 @@
(hs-activate! _el-pf)
))
(deftest "can filter events based on count"
(error "SKIP (skip-list): can filter events based on count"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click 1 put 1 + my.innerHTML as Int into my.innerHTML")
(dom-set-inner-html _el-div "0")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
))
(deftest "can filter events based on count range"
(error "SKIP (skip-list): can filter events based on count range"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click 1 to 2 put 1 + my.innerHTML as Int into my.innerHTML")
(dom-set-inner-html _el-div "0")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
))
(deftest "can filter events based on unbounded count range"
(error "SKIP (skip-list): can filter events based on unbounded count range"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click 2 and on put 1 + my.innerHTML as Int into my.innerHTML")
(dom-set-inner-html _el-div "0")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
))
(deftest "can fire an event on load"
(hs-cleanup!)
(let ((_el-d1 (dom-create-element "div")))
@@ -8951,7 +8969,13 @@
(hs-activate! _el-div)
))
(deftest "can mix ranges"
(error "SKIP (skip-list): can mix ranges"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on click 1 put \"one\" into my.innerHTML on click 3 put \"three\" into my.innerHTML on click 2 put \"two\" into my.innerHTML")
(dom-set-inner-html _el-div "0")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
))
(deftest "can pick detail fields out by name"
(error "SKIP (skip-list): can pick detail fields out by name"))
(deftest "can pick event properties out by name"
@@ -9121,7 +9145,13 @@
(deftest "multiple event handlers at a time are allowed to execute with the every keyword"
(error "SKIP (skip-list): multiple event handlers at a time are allowed to execute with the every keyword"))
(deftest "on first click fires only once"
(error "SKIP (skip-list): on first click fires only once"))
(hs-cleanup!)
(let ((_el-div (dom-create-element "div")))
(dom-set-attr _el-div "_" "on first click put 1 + my.innerHTML as Int into my.innerHTML")
(dom-set-inner-html _el-div "0")
(dom-append (dom-body) _el-div)
(hs-activate! _el-div)
))
(deftest "on intersection fires when the element is in the viewport"
(hs-cleanup!)
(let ((_el-d (dom-create-element "div")))

View File

@@ -110,10 +110,6 @@ SKIP_TEST_NAMES = {
"can pick event properties out by name",
"can be in a top level script tag",
"multiple event handlers at a time are allowed to execute with the every keyword",
"can filter events based on count",
"can filter events based on count range",
"can filter events based on unbounded count range",
"can mix ranges",
"each behavior installation has its own event queue",
"can catch exceptions thrown in js functions",
"can catch exceptions thrown in hyperscript functions",
@@ -129,7 +125,6 @@ SKIP_TEST_NAMES = {
"can ignore when target doesn't exist",
"can ignore when target doesn\\'t exist",
"can handle an or after a from clause",
"on first click fires only once",
"supports \"elsewhere\" modifier",
"supports \"from elsewhere\" modifier",
# upstream 'def' category — namespaced def + dynamic `me` inside callee