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
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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user