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

R7RS guard special form + transpiler fixes

Browse Source 
- guard as CEK special form in evaluator.sx, desugars to call/cc +
  handler-bind with sentinel-based re-raise (avoids handler loop)
- bootstrap.py: fix bind_lambda_with_rest type annotations, auto-inject
  make_raise_guard_frame when transpiler drops it
- mcp_tree: add timeout param to sx_test (default 300s)
- 2566/2568 tests pass (2 pre-existing scope failures)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-03 12:34:01 +00:00
parent 508a0017a7
commit 21ad052272
4 changed files with 105 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
spec/evaluator.sx
View File

@@ -1028,6 +1028,79 @@
env
(kont-push (make-raise-eval-frame env false) kont))))
(define
step-sf-guard
(fn
(args env kont)
(let
((var-clauses (first args))
(body (rest args))
(var (first var-clauses))
(clauses (rest var-clauses))
(sentinel (make-symbol "__guard-reraise__")))
(step-eval-list
(list
(quote let)
(list
(list
(quote __guard-result)
(cons
(quote call/cc)
(list
(cons
(quote fn)
(cons
(quote (__guard-k))
(list
(cons
(quote handler-bind)
(cons
(list
(list
(cons
(quote fn)
(cons (quote (_)) (quote (true))))
(cons
(quote fn)
(cons
(list var)
(list
(list
(quote __guard-k)
(cons
(quote cond)
(append
clauses
(list
(list
(quote else)
(list
(quote list)
(list
(quote quote)
sentinel)
var)))))))))))
(list
(list
(quote __guard-k)
(cons (quote begin) body))))))))))))
(list
(quote if)
(list
(quote and)
(list (quote list?) (quote __guard-result))
(list (quote =) (list (quote len) (quote __guard-result)) 2)
(list
(quote =)
(list (quote first) (quote __guard-result))
(list (quote quote) sentinel)))
(list
(quote raise)
(list (quote nth) (quote __guard-result) 1))
(quote __guard-result)))
env
kont))))
(define
step-eval-list
(fn
@@ -1116,6 +1189,7 @@
env
kont))
(step-sf-begin args env kont)))
("guard" (step-sf-guard args env kont))
("quote"
(make-cek-value
(if (empty? args) nil (first args))