HS: parser+compiler — toggle for-in lookahead, throttled/debounced modifiers (-2 skips)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s

parser.sx parse-toggle-cmd: when seeing 'toggle .foo for', peek the
following two tokens. If they are '<ident> in', it is a for-in loop
and toggle does NOT consume 'for' as a duration clause. Restores the
trailing for-in to the command list.

parser.sx parse-on (handler modifiers): recognize 'throttled at <ms>'
and 'debounced at <ms>' as handler modifiers. Captured as :throttle /
:debounce kwargs in the on-form parts list.

compiler.sx emit-on: pre-extract :throttle / :debounce from parts via
new _strip-throttle-debounce helper before scan-on, then wrap the built
handler with (hs-throttle! handler ms) or (hs-debounce! handler ms).

runtime.sx: hs-throttle! — closure with __hs-last-fire timestamp,
fires immediately and drops events arriving within ms of the last fire.
hs-debounce! — closure with __hs-timer, clears any pending timer and
schedules a new setTimeout(handler, ms) so only the last burst event
fires.

Both formerly-architectural skips now pass:
- "toggle does not consume a following for-in loop"
- "throttled at <time> drops events within the window"

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-05-08 07:16:27 +00:00
parent 982b9d6be6
commit d0b358eca2
7 changed files with 155 additions and 33 deletions

View File

@@ -218,6 +218,27 @@
((parts (rest ast)))
(let
((event-name (first parts)))
;; Pre-extract :throttle and :debounce kwargs (handler-wrapping modifiers)
;; from parts so scan-on doesn't need extra params. Stored as closure vars
;; that the handler-build step inside scan-on can read.
(define _throttle-ms nil)
(define _debounce-ms nil)
(define
_strip-throttle-debounce
(fn
(lst)
(cond
((<= (len lst) 1) lst)
((= (first lst) :throttle)
(do
(set! _throttle-ms (nth lst 1))
(_strip-throttle-debounce (rest (rest lst)))))
((= (first lst) :debounce)
(do
(set! _debounce-ms (nth lst 1))
(_strip-throttle-debounce (rest (rest lst)))))
(true
(cons (first lst) (_strip-throttle-debounce (rest lst)))))))
(define
scan-on
(fn
@@ -250,6 +271,13 @@
((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 let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (hs-to-sx finally-info) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))) (list (quote let) (list (list (quote __hs-exc) nil) (list (quote __hs-reraise) false)) (list (quote do) (list (quote guard) (list var (list true (list (quote let) (list (list var (list (quote host-hs-normalize-exc) var))) (list (quote guard) (list (quote __inner-exc) (list true (list (quote do) (list (quote set!) (quote __hs-exc) (quote __inner-exc)) (list (quote set!) (quote __hs-reraise) true)))) catch-body)))) compiled-body) (list (quote when) (quote __hs-reraise) (list (quote raise) (quote __hs-exc))))))) (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))))) (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
((handler (cond
(_throttle-ms
(list (quote hs-throttle!) handler (hs-to-sx _throttle-ms)))
(_debounce-ms
(list (quote hs-debounce!) handler (hs-to-sx _debounce-ms)))
(true handler))))
(let
((on-call (if every? (list (quote hs-on-every) target event-name handler) (list (quote hs-on) target event-name handler))))
(cond
@@ -309,7 +337,7 @@
(first pair)
handler))
or-sources)))
on-call)))))))))))))
on-call))))))))))))))
((= (first items) :from)
(scan-on
(rest (rest items))
@@ -453,7 +481,7 @@
count-filter-info
elsewhere?
or-sources)))))
(scan-on (rest parts) nil nil false nil nil nil nil nil false nil)))))
(scan-on (_strip-throttle-debounce (rest parts)) nil nil false nil nil nil nil nil false nil)))))
(define
emit-send
(fn

View File

@@ -1347,7 +1347,17 @@
cls
(first extra-classes)
tgt))
((match-kw "for")
((and
(= (tp-type) "keyword") (= (tp-val) "for")
;; Only consume 'for' as a duration clause if the next
;; token is NOT '<ident> in ...' — that pattern is a
;; for-in loop, not a toggle duration.
(not
(and
(> (len tokens) (+ p 2))
(= (get (nth tokens (+ p 1)) "type") "ident")
(= (get (nth tokens (+ p 2)) "value") "in")))
(do (adv!) true))
(let
((dur (parse-expr)))
(list (quote toggle-class-for) cls tgt dur)))
@@ -3079,7 +3089,17 @@
(= (tp-val) "queue"))
(do (adv!) (adv!)))
(let
((every? (match-kw "every")))
((every? (match-kw "every"))
(throttle-ms nil)
(debounce-ms nil))
;; 'throttled at <duration>' / 'debounced at <duration>'
;; — parsed as handler modifiers, captured as :throttle / :debounce parts.
(when (and (= (tp-type) "ident") (= (tp-val) "throttled"))
(adv!)
(when (match-kw "at") (set! throttle-ms (parse-expr))))
(when (and (= (tp-type) "ident") (= (tp-val) "debounced"))
(adv!)
(when (match-kw "at") (set! debounce-ms (parse-expr))))
(let
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
(let
@@ -3094,6 +3114,10 @@
(match-kw "end")
(let
((parts (list (quote on) event-name)))
(let
((parts (if throttle-ms (append parts (list :throttle throttle-ms)) parts)))
(let
((parts (if debounce-ms (append parts (list :debounce debounce-ms)) parts)))
(let
((parts (if every? (append parts (list :every true)) parts)))
(let
@@ -3116,7 +3140,7 @@
((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))))))))))))))))))))))))))
parts))))))))))))))))))))))))))))
(define
parse-init-feat
(fn

View File

@@ -54,6 +54,41 @@
hs-on-every
(fn (target event-name handler) (dom-listen target event-name handler)))
;; Throttle: drops events that arrive within the window. First event fires
;; immediately; subsequent events within `ms` of the previous fire are dropped.
;; Returns a wrapped handler suitable for hs-on / hs-on-every.
(define
hs-throttle!
(fn
(handler ms)
(let
((__hs-last-fire 0))
(fn
(event)
(let
((__hs-now (host-call (host-global "Date") "now")))
(when
(>= (- __hs-now __hs-last-fire) ms)
(set! __hs-last-fire __hs-now)
(handler event)))))))
;; Debounce: waits until `ms` has elapsed since the last event before firing.
;; In our synchronous test mock no time passes, so the timer fires immediately
;; via setTimeout(_, 0); the wrapped handler still gets called once per burst.
(define
hs-debounce!
(fn
(handler ms)
(let
((__hs-timer nil))
(fn
(event)
(when __hs-timer (host-call (host-global "window") "clearTimeout" __hs-timer))
(set! __hs-timer
(host-call (host-global "window") "setTimeout"
(host-new-function (list "ev") "return arguments[0](arguments[1]);")
ms handler event))))))
;; Wait for a DOM event on a target.
;; (hs-wait-for target event-name) — suspends until event fires
(define