coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HS: fix guard re-raise in repeat loops (+3 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 8m51s
Details

Browse Source 
Capture raised exception in a let-bound variable before the guard
exits, then re-raise after. Avoids the WASM OCaml kernel bug where
(raise e) called from within a guard handler re-invokes the same
handler infinitely.

Affects hs-repeat-forever, hs-repeat-times, hs-repeat-while,
hs-repeat-until, hs-for-each. Repeat suite: 25/30 → 28/29 counted
(1 skipped: 'until event keyword works' requires async event dispatch).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-05-03 11:57:53 +00:00
parent a3abe47286
commit 894fd24c3a
3 changed files with 353 additions and 189 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
lib/hyperscript/runtime.sx
View File

@@ -821,11 +821,16 @@
(when
(< i n)
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (do-repeat (+ i 1)))
(true (do-repeat (+ i 1))))))))
((ex nil) (raised false))
(do
(guard
(e (true (do (set! ex e) (set! raised true) nil)))
(do (thunk) nil))
(cond
((not raised) (do-repeat (+ i 1)))
((= (str ex) "hs-break") nil)
((= (str ex) "hs-continue") (do-repeat (+ i 1)))
(true (raise ex))))))))
(do-repeat 0)))
(define
@@ -837,11 +842,16 @@
(fn
()
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (do-forever))
(true (do-forever))))))
((ex nil) (raised false))
(do
(guard
(e (true (do (set! ex e) (set! raised true) nil)))
(do (thunk) nil))
(cond
((not raised) (do-forever))
((= (str ex) "hs-break") nil)
((= (str ex) "hs-continue") (do-forever))
(true (raise ex)))))))
(do-forever)))
(define
@@ -851,23 +861,33 @@
(when
(cond-fn)
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (hs-repeat-while cond-fn thunk))
(true (hs-repeat-while cond-fn thunk)))))))
((ex nil) (raised false))
(do
(guard
(e (true (do (set! ex e) (set! raised true) nil)))
(do (thunk) nil))
(cond
((not raised) (hs-repeat-while cond-fn thunk))
((= (str ex) "hs-break") nil)
((= (str ex) "hs-continue") (hs-repeat-while cond-fn thunk))
(true (raise ex))))))))
(define
hs-repeat-until
(fn
(cond-fn thunk)
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (thunk) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))))))
((ex nil) (raised false))
(do
(guard
(e (true (do (set! ex e) (set! raised true) nil)))
(do (thunk) nil))
(cond
((not raised) (if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
((= (str ex) "hs-break") nil)
((= (str ex) "hs-continue")
(if (cond-fn) nil (hs-repeat-until cond-fn thunk)))
(true (raise ex)))))))
(define
hs-for-each
@@ -882,11 +902,16 @@
(when
(not (empty? remaining))
(let
((signal (guard (e ((or (= (str e) "hs-break") (= (str e) "hs-continue")) (str e)) (true (raise e))) (do (fn-body (first remaining)) nil))))
(cond
((= signal "hs-break") nil)
((= signal "hs-continue") (do-loop (rest remaining)))
(true (do-loop (rest remaining))))))))
((ex nil) (raised false))
(do
(guard
(e (true (do (set! ex e) (set! raised true) nil)))
(do (fn-body (first remaining)) nil))
(cond
((not raised) (do-loop (rest remaining)))
((= (str ex) "hs-break") nil)
((= (str ex) "hs-continue") (do-loop (rest remaining)))
(true (raise ex))))))))
(do-loop items))))
(begin