scheme: Phase 5b — R7RS exceptions (raise/guard/with-exception-handler) + 12 tests

eval.sx adds the `guard` syntactic operator with R7RS-compliant
clause dispatch: var binds to raised value in a fresh child env;
clauses tried in order; `else` is catch-all; no match re-raises.

Implementation uses a "catch-once-then-handle-outside" pattern to
avoid the handler self-raise loop:
  outcome = host-guard {body}            ;; tag raise vs success
  if outcome was raise:
    try clauses → either result or sentinel
    if sentinel: re-raise OUTSIDE the host-guard scope

runtime.sx binds R7RS exception primitives:
- raise V
- error MSG IRRITANT...  → {:scm-error MSG :irritants LIST}
- error-object?, error-object-message, error-object-irritants
- with-exception-handler HANDLER THUNK
  (same outcome-sentinel pattern — handler's own raises propagate
  outward instead of re-entering)

12 tests cover: catch on raise, predicate dispatch, else catch-all,
no-error pass-through, first-clause-wins, re-raise-on-no-match,
error-object construction and accessors.

232 total Scheme tests now (62 + 23 + 49 + 78 + 20).

lib/scheme/eval.sx

@@ -334,6 +334,77 @@
 (scheme-define-op! "or"
   (fn (args env) (scm-or-step args env)))
 
+;; ── guard (R7RS exception clause-dispatch syntactic form) ────────
+;; (guard (var (test1 body1) (test2 body2) ... [else body]) body...)
+;;
+;; Evaluates body in an exception-protected scope. If an exception is
+;; raised, var is bound to the raised value in a fresh child env, the
+;; cond-like clauses are tried in order, and the first matching clause's
+;; body is returned. If no clause matches (and no else), the exception
+;; re-raises. The bare `else` symbol is the catch-all per R7RS.
+
+;; Sentinel that means "no clause matched; re-raise outside the guard".
+(define scm-guard-no-match-marker {:scm-guard-no-match true})
+
+(define scm-guard-try-clauses
+  (fn (clauses env raised)
+    (cond
+      ((or (nil? clauses) (= (length clauses) 0))
+        scm-guard-no-match-marker)
+      (:else
+        (let ((clause (first clauses)))
+          (cond
+            ((not (list? clause)) scm-guard-no-match-marker)
+            ((and (string? (first clause)) (= (first clause) "else"))
+              (scheme-eval-body (rest clause) env))
+            (:else
+              (let ((test-val (scheme-eval (first clause) env)))
+                (cond
+                  ((not (= test-val false))
+                    (cond
+                      ((= (length clause) 1) test-val)
+                      (:else (scheme-eval-body (rest clause) env))))
+                  (:else
+                    (scm-guard-try-clauses (rest clauses) env raised)))))))))))
+
+(define scm-guard-handle
+  (fn (raised-val var-name clauses env)
+    (let ((local (scheme-extend-env env)))
+      (begin
+        (scheme-env-bind! local var-name raised-val)
+        (scm-guard-try-clauses clauses local raised-val)))))
+
+(scheme-define-op! "guard"
+  (fn (args env)
+    (cond
+      ((< (length args) 1)
+        (error "guard: expects ((var clauses...) body...)"))
+      ((not (list? (first args)))
+        (error "guard: first form must be (var clauses...)"))
+      ((= (length (first args)) 0)
+        (error "guard: clause list needs a var name"))
+      (:else
+        (let ((var-name (first (first args)))
+              (clauses (rest (first args)))
+              (body (rest args)))
+          ;; Catch once; if no clause matches, the sentinel is returned
+          ;; and we re-raise OUTSIDE the guard scope (so the re-raise
+          ;; doesn't itself get caught).
+          (let ((outcome
+                  (guard
+                    (e (true {:scm-guard-raised true :value e}))
+                    (scheme-eval-body body env))))
+            (cond
+              ((and (dict? outcome) (get outcome :scm-guard-raised))
+                (let ((result (scm-guard-handle (get outcome :value)
+                                                var-name clauses env)))
+                  (cond
+                    ((and (dict? result)
+                          (get result :scm-guard-no-match))
+                      (raise (get outcome :value)))
+                    (:else result))))
+              (:else outcome))))))))
+
 ;; ── eval-args helper ─────────────────────────────────────────────
 
 (define

lib/scheme/runtime.sx

@@ -531,4 +531,59 @@
                     (scheme-apply (first args) (list scheme-k)))))))))
       (scheme-env-bind! env "call-with-current-continuation"
         (refl-env-lookup env "call/cc"))
+      ;; ── R7RS exception primitives ──────────────────────────
+      ;; raise V — raises V as exception (host SX raise).
+      (scheme-env-bind! env "raise"
+        (fn (args)
+          (cond
+            ((not (= (length args) 1))
+              (error "raise: expects 1 argument"))
+            (:else (raise (first args))))))
+      ;; error MSG IRRITANTS... — convention: raise an error-object
+      ;; that's a dict {:scm-error MSG :irritants LIST}. The print
+      ;; surface (error-object-message / error-object-irritants)
+      ;; can pull these apart.
+      (scheme-env-bind! env "error"
+        (fn (args)
+          (cond
+            ((= (length args) 0) (error "error: expects (message [irritant...])"))
+            (:else
+              (raise {:scm-error (cond
+                                   ((scheme-string? (first args))
+                                     (scheme-string-value (first args)))
+                                   (:else (first args)))
+                      :irritants (rest args)})))))
+      (scheme-env-bind! env "error-object?"
+        (scm-unary "error-object?"
+          (fn (v) (and (dict? v) (string? (get v :scm-error))))))
+      (scheme-env-bind! env "error-object-message"
+        (scm-unary "error-object-message"
+          (fn (v) (scheme-string-make (get v :scm-error)))))
+      (scheme-env-bind! env "error-object-irritants"
+        (scm-unary "error-object-irritants"
+          (fn (v) (get v :irritants))))
+      ;; with-exception-handler HANDLER THUNK — runs THUNK; if it
+      ;; raises, calls HANDLER with the raised value (handler can
+      ;; itself raise or return a value). Implemented via host guard.
+      ;; with-exception-handler — catch THUNK's raise; if caught,
+      ;; call HANDLER. If HANDLER itself raises, propagate that to
+      ;; the outer scope (don't re-catch in this same guard, which
+      ;; would loop). The two-step outcome-sentinel pattern mirrors
+      ;; the `guard` special form's escape.
+      (scheme-env-bind! env "with-exception-handler"
+        (fn (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "with-exception-handler: expects 2 arguments"))
+            (:else
+              (let ((handler (first args))
+                    (thunk (nth args 1)))
+                (let ((outcome
+                        (guard
+                          (e (true {:scm-weh-raised true :value e}))
+                          (scheme-apply thunk (list)))))
+                  (cond
+                    ((and (dict? outcome) (get outcome :scm-weh-raised))
+                      (scheme-apply handler (list (get outcome :value))))
+                    (:else outcome))))))))
       env)))

lib/scheme/tests/control.sx

@@ -69,4 +69,47 @@
   (scm-ctl "(procedure? (call/cc (lambda (k) k)))")
   true)
 
+;; ── Exceptions: raise / guard / with-exception-handler / error ──
+(scm-ctl-test "raise + guard caught"
+  (scm-ctl "(guard (e (else 'caught)) (raise 'boom))") "caught")
+(scm-ctl-test "guard: number? matches"
+  (scm-ctl "(guard (e ((number? e) e) (else 'other)) (raise 42))") 42)
+(scm-ctl-test "guard: number? mismatches → else"
+  (scm-ctl "(guard (e ((number? e) e) (else 'other)) (raise 'sym))")
+  "other")
+(scm-ctl-test "guard: no error → body value"
+  (scm-ctl "(guard (e (else 'never)) 42)") 42)
+(scm-ctl-test "guard: first matching clause wins"
+  (scm-ctl
+    "(guard (e ((number? e) 'num) ((symbol? e) 'sym) (else 'other)) (raise 'foo))")
+  "sym")
+(scm-ctl-test "guard: re-raises when no clause matches"
+  (scm-ctl
+    "(guard (e (else 'outer)) (guard (e ((number? e) 'inner)) (raise 'not-a-number)))")
+  "outer")
+(scm-ctl-test "guard: var bound in clause body"
+  (scm-ctl "(guard (e ((symbol? e) e)) (raise 'the-symbol))")
+  "the-symbol")
+(scm-ctl-test "with-exception-handler: caught"
+  (scm-ctl
+    "(with-exception-handler (lambda (e) 'caught) (lambda () (raise 'oops)))")
+  "caught")
+(scm-ctl-test "with-exception-handler: no raise"
+  (scm-ctl
+    "(with-exception-handler (lambda (e) 99) (lambda () 42))")
+  42)
+(scm-ctl-test "with-exception-handler: handler sees the value"
+  (scm-ctl
+    "(with-exception-handler (lambda (e) (+ e 1)) (lambda () (raise 41)))")
+  42)
+(scm-ctl-test "error: irritants accessible"
+  (scm-ctl
+    "(guard (e ((error-object? e) (error-object-irritants e))) (error \"msg\" 1 2 3))")
+  (list 1 2 3))
+(scm-ctl-test "error: message accessible"
+  (scheme-string-value
+    (scm-ctl
+      "(guard (e ((error-object? e) (error-object-message e))) (error \"the-msg\"))"))
+  "the-msg")
+
 (define scm-ctl-tests-run! (fn () {:total (+ scm-ctl-pass scm-ctl-fail) :passed scm-ctl-pass :failed scm-ctl-fail :fails scm-ctl-fails}))