haskell: Phase 16 — exception handling (catch/try/throwIO/evaluate/handle/throw)

hk-bind-exceptions! in eval.sx registers throwIO, throw, evaluate, catch,
try, handle, displayException. SomeException constructor pre-registered
in runtime.sx (arity 1, type SomeException).

throwIO and the existing error primitive both raise via SX `raise` with a
uniform "hk-error: msg" string. catch/try/handle parse it back into a
SomeException via hk-exception-of, which strips nested
'Unhandled exception: "..."' host wraps (CEK's host_error formatter) and
the "hk-error: " prefix.

catch and handle evaluate the handler outside the guard scope (build an
"ok"/"exn" outcome tag inside guard, then dispatch outside) so that a
re-throw from the handler propagates past this catch — matching Haskell
semantics rather than infinite-looping in the same guard.

14 unit tests in tests/exceptions.sx (catch success, catch error, try
Right/Left, handle, throwIO + catch/try, evaluate, nested catch, do-bind
through catch, branch on try result, IORef-mutating handler).

Conformance: safediv.hs (8/8) and trycatch.hs (8/8). Scoreboard now
285/285 tests, 36/36 programs.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>

lib/haskell/conformance.sh

@@ -20,7 +20,7 @@ if [ ! -x "$SX_SERVER" ]; then
   fi
 fi
 
-PROGRAMS=(fib sieve quicksort nqueens calculator collatz palindrome maybe fizzbuzz anagram roman binary either primes zipwith matrix wordcount powers caesar runlength-str showadt showio partial statistics newton wordfreq mapgraph uniquewords setops shapes person config counter accumulate)
+PROGRAMS=(fib sieve quicksort nqueens calculator collatz palindrome maybe fizzbuzz anagram roman binary either primes zipwith matrix wordcount powers caesar runlength-str showadt showio partial statistics newton wordfreq mapgraph uniquewords setops shapes person config counter accumulate safediv trycatch)
 PASS_COUNTS=()
 FAIL_COUNTS=()
 

lib/haskell/eval.sx

@@ -790,6 +790,7 @@
       (dict-set! env "rem" (hk-make-binop-builtin "rem" "rem"))
       (dict-set! env "quot" (hk-make-binop-builtin "quot" "quot"))
       (dict-set! env "show" (hk-mk-lazy-builtin "show" hk-show-val 1))
+      (hk-bind-exceptions! env)
       (hk-load-into! env hk-prelude-src)
       (begin
         (dict-set!
@@ -1364,6 +1365,148 @@
                   (list "IO" (list "Tuple")))))
             2))))))
 
+(define
+  hk-strip-prefix
+  (fn
+    (s prefix)
+    (let ((pl (string-length prefix)) (sl (string-length s)))
+      (cond
+        ((and (>= sl pl) (= (substr s 0 pl) prefix))
+          (substr s pl (- sl pl)))
+        (:else s)))))
+
+(define
+  hk-strip-quotes-once
+  (fn
+    (s)
+    (let ((sl (string-length s)))
+      (cond
+        ((and (>= sl 2)
+              (= (substr s 0 1) "\"")
+              (= (substr s (- sl 1) 1) "\""))
+          (substr s 1 (- sl 2)))
+        ((and (>= sl 4)
+              (= (substr s 0 2) "\\\"")
+              (= (substr s (- sl 2) 2) "\\\""))
+          (substr s 2 (- sl 4)))
+        (:else s)))))
+
+(define
+  hk-strip-host-wrap-once
+  (fn
+    (s)
+    (let ((s1 (hk-strip-prefix s "Unhandled exception: ")))
+      (cond
+        ((= s1 s) s)
+        (:else (hk-strip-quotes-once s1))))))
+
+(define
+  hk-strip-host-wrap
+  (fn
+    (s)
+    (let ((s1 (hk-strip-host-wrap-once s)))
+      (cond
+        ((= s1 s) s)
+        (:else (hk-strip-host-wrap s1))))))
+
+(define
+  hk-exception-msg
+  (fn
+    (v)
+    (let ((fv (hk-deep-force v)))
+      (cond
+        ((string? fv) fv)
+        ((and (list? fv) (not (empty? fv))
+              (= (first fv) "SomeException"))
+          (let ((m (nth fv 1)))
+            (if (string? m) m (str m))))
+        (:else (str fv))))))
+
+(define
+  hk-exception-of
+  (fn
+    (e)
+    (cond
+      ((and (list? e) (not (empty? e))
+            (= (first e) "hk-haskell-exception"))
+        (nth e 1))
+      ((string? e)
+        (let ((s (hk-strip-host-wrap e)))
+          (let ((s2 (hk-strip-prefix s "hk-error: ")))
+            (list "SomeException" s2))))
+      (:else (list "SomeException" (str e))))))
+
+(define
+  hk-bind-exceptions!
+  (fn
+    (env)
+    (begin
+      (dict-set! env "throwIO"
+        (hk-mk-lazy-builtin "throwIO"
+          (fn (e) (raise (str "hk-error: " (hk-exception-msg e))))
+          1))
+      (dict-set! env "throw"
+        (hk-mk-lazy-builtin "throw"
+          (fn (e) (raise (str "hk-error: " (hk-exception-msg e))))
+          1))
+      (dict-set! env "evaluate"
+        (hk-mk-lazy-builtin "evaluate"
+          (fn (x)
+            (let ((v (hk-deep-force x)))
+              (list "IO" v)))
+          1))
+      (dict-set! env "catch"
+        (hk-mk-lazy-builtin "catch"
+          (fn (action handler)
+            (let
+              ((outcome
+                 (guard
+                   (e (true (list "exn" e)))
+                   (list "ok" (hk-force action)))))
+              (cond
+                ((= (first outcome) "ok") (nth outcome 1))
+                (:else
+                  (let ((some-ex (hk-exception-of (nth outcome 1))))
+                    (hk-force (hk-apply (hk-force handler) some-ex)))))))
+          2))
+      (dict-set! env "try"
+        (hk-mk-lazy-builtin "try"
+          (fn (action)
+            (guard
+              (e (true
+                   (list "IO" (list "Left" (hk-exception-of e)))))
+              (let ((io-val (hk-force action)))
+                (cond
+                  ((and (list? io-val) (= (first io-val) "IO"))
+                    (list "IO" (list "Right" (nth io-val 1))))
+                  (:else
+                    (raise "try: action did not produce IO"))))))
+          1))
+      (dict-set! env "handle"
+        (hk-mk-lazy-builtin "handle"
+          (fn (handler action)
+            (let
+              ((outcome
+                 (guard
+                   (e (true (list "exn" e)))
+                   (list "ok" (hk-force action)))))
+              (cond
+                ((= (first outcome) "ok") (nth outcome 1))
+                (:else
+                  (let ((some-ex (hk-exception-of (nth outcome 1))))
+                    (hk-force (hk-apply (hk-force handler) some-ex)))))))
+          2))
+      (dict-set! env "displayException"
+        (hk-mk-lazy-builtin "displayException"
+          (fn (e)
+            (let ((v (hk-force e)))
+              (cond
+                ((and (list? v) (not (empty? v))
+                      (= (first v) "SomeException"))
+                  (hk-deep-force (nth v 1)))
+                (:else (str v)))))
+          1)))))
+
 (define
   hk-bind-decls!
   (fn

lib/haskell/runtime.sx

@@ -102,6 +102,7 @@
 (hk-register-con! "LT" 0 "Ordering")
 (hk-register-con! "EQ" 0 "Ordering")
 (hk-register-con! "GT" 0 "Ordering")
+(hk-register-con! "SomeException" 1 "SomeException")
 
 (define
   hk-str?

lib/haskell/scoreboard.json

@@ -1,6 +1,6 @@
 {
-  "date": "2026-05-07",
+  "date": "2026-05-08",
-  "total_pass": 269,
+  "total_pass": 285,
   "total_fail": 0,
   "programs": {
     "fib": {"pass": 2, "fail": 0},
@@ -36,6 +36,8 @@
     "person": {"pass": 7, "fail": 0},
     "config": {"pass": 10, "fail": 0},
     "counter": {"pass": 7, "fail": 0},
-    "accumulate": {"pass": 8, "fail": 0}
+    "accumulate": {"pass": 8, "fail": 0},
+    "safediv": {"pass": 8, "fail": 0},
+    "trycatch": {"pass": 8, "fail": 0}
   }
 }

lib/haskell/scoreboard.md

@@ -1,6 +1,6 @@
 # Haskell-on-SX Scoreboard
 
-Updated 2026-05-07 · Phase 6 (prelude extras + 18 programs)
+Updated 2026-05-08 · Phase 6 (prelude extras + 18 programs)
 
 | Program | Tests | Status |
 |---------|-------|--------|
@@ -38,4 +38,6 @@ Updated 2026-05-07 · Phase 6 (prelude extras + 18 programs)
 | config.hs | 10/10 | ✓ |
 | counter.hs | 7/7 | ✓ |
 | accumulate.hs | 8/8 | ✓ |
-| **Total** | **269/269** | **34/34 programs** |
+| safediv.hs | 8/8 | ✓ |
+| trycatch.hs | 8/8 | ✓ |
+| **Total** | **285/285** | **36/36 programs** |

lib/haskell/tests/exceptions.sx

@@ -0,0 +1,105 @@
+;; Phase 16 — Exception handling unit tests.
+
+(hk-test
+  "catch — success path returns the action result"
+  (hk-deep-force
+    (hk-run
+      "main = catch (return 42) (\\(SomeException m) -> return 0)"))
+  (list "IO" 42))
+
+(hk-test
+  "catch — error caught, handler receives message"
+  (hk-deep-force
+    (hk-run
+      "main = catch (error \"boom\") (\\(SomeException m) -> return m)"))
+  (list "IO" "boom"))
+
+(hk-test
+  "try — success returns Right v"
+  (hk-deep-force
+    (hk-run "main = try (return 42)"))
+  (list "IO" (list "Right" 42)))
+
+(hk-test
+  "try — error returns Left (SomeException msg)"
+  (hk-deep-force
+    (hk-run "main = try (error \"oops\")"))
+  (list "IO" (list "Left" (list "SomeException" "oops"))))
+
+(hk-test
+  "handle — flip catch — caught error message"
+  (hk-deep-force
+    (hk-run
+      "main = handle (\\(SomeException m) -> return m) (error \"hot\")"))
+  (list "IO" "hot"))
+
+(hk-test
+  "throwIO + catch — handler sees the SomeException"
+  (hk-deep-force
+    (hk-run
+      "main = catch (throwIO (SomeException \"bang\")) (\\(SomeException m) -> return m)"))
+  (list "IO" "bang"))
+
+(hk-test
+  "throwIO + try — Left side"
+  (hk-deep-force
+    (hk-run
+      "main = try (throwIO (SomeException \"x\"))"))
+  (list "IO" (list "Left" (list "SomeException" "x"))))
+
+(hk-test
+  "evaluate — pure value returns IO v"
+  (hk-deep-force
+    (hk-run "main = evaluate (1 + 2 + 3)"))
+  (list "IO" 6))
+
+(hk-test
+  "evaluate — error surfaces as catchable exception"
+  (hk-deep-force
+    (hk-run
+      "main = catch (evaluate (error \"deep\")) (\\(SomeException m) -> return m)"))
+  (list "IO" "deep"))
+
+(hk-test
+  "nested catch — inner handler runs first"
+  (hk-deep-force
+    (hk-run
+      "main = catch (catch (error \"inner\") (\\(SomeException m) -> error (m ++ \"-rethrown\"))) (\\(SomeException m) -> return m)"))
+  (list "IO" "inner-rethrown"))
+
+(hk-test
+  "catch chain — handler can succeed inside IO"
+  (hk-deep-force
+    (hk-run
+      "main = do { x <- catch (error \"e1\") (\\(SomeException m) -> return 100); return (x + 1) }"))
+  (list "IO" 101))
+
+(hk-test
+  "try then bind on Right"
+  (hk-deep-force
+    (hk-run
+      "branch (Right v) = return (v * 2)
+branch (Left _) = return 0
+main = do { r <- try (return 21); branch r }"))
+  (list "IO" 42))
+
+(hk-test
+  "try then bind on Left"
+  (hk-deep-force
+    (hk-run
+      "branch (Right _) = return \"ok\"
+branch (Left (SomeException m)) = return m
+main = do { r <- try (error \"failed\"); branch r }"))
+  (list "IO" "failed"))
+
+(hk-test
+  "catch — handler can use closed-over IORef"
+  (hk-deep-force
+    (hk-run
+      "import qualified Data.IORef as IORef
+main = do
+  r <- IORef.newIORef 0
+  catch (error \"x\") (\\(SomeException m) -> IORef.writeIORef r 7)
+  v <- IORef.readIORef r
+  return v"))
+  (list "IO" 7))

lib/haskell/tests/program-safediv.sx

@@ -0,0 +1,80 @@
+;; safediv.hs — safe division using catch (Phase 16 conformance).
+
+(define
+  hk-safediv-source
+  "safeDiv :: Int -> Int -> IO Int
+safeDiv _ 0 = throwIO (SomeException \"division by zero\")
+safeDiv x y = return (x `div` y)
+
+guarded :: Int -> Int -> IO Int
+guarded x y = catch (safeDiv x y) (\\(SomeException _) -> return 0)
+
+reason :: Int -> Int -> IO String
+reason x y = catch (safeDiv x y `seq` return \"ok\")
+  (\\(SomeException m) -> return m)
+
+bothBranches :: Int -> Int -> IO Int
+bothBranches x y = do
+  v <- catch (safeDiv x y) (\\(SomeException _) -> return (-1))
+  return (v + 100)
+
+")
+
+(hk-test
+  "safediv.hs — divide by non-zero"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = guarded 10 2")))
+  (list "IO" 5))
+
+(hk-test
+  "safediv.hs — divide by zero returns 0"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = guarded 10 0")))
+  (list "IO" 0))
+
+(hk-test
+  "safediv.hs — divide by zero — reason captured"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = catch (safeDiv 1 0) (\\(SomeException m) -> return 0) >> reason 1 0")))
+  (list "IO" "division by zero"))
+
+(hk-test
+  "safediv.hs — bothBranches success path"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = bothBranches 8 2")))
+  (list "IO" 104))
+
+(hk-test
+  "safediv.hs — bothBranches failure path"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source "main = bothBranches 8 0")))
+  (list "IO" 99))
+
+(hk-test
+  "safediv.hs — chained safeDiv with catch"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source
+        "main = do { a <- guarded 20 4; b <- guarded 7 0; return (a + b) }")))
+  (list "IO" 5))
+
+(hk-test
+  "safediv.hs — try then bind through Either"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source
+        "main = do { r <- try (safeDiv 1 0); case r of { Right v -> return v; Left (SomeException m) -> return 999 } }")))
+  (list "IO" 999))
+
+(hk-test
+  "safediv.hs — handle (flip catch)"
+  (hk-deep-force
+    (hk-run
+      (str hk-safediv-source
+        "main = handle (\\(SomeException _) -> return 0) (safeDiv 5 0)")))
+  (list "IO" 0))

lib/haskell/tests/program-trycatch.sx

@@ -0,0 +1,95 @@
+;; trycatch.hs — try pattern: branch on Left/Right (Phase 16 conformance).
+
+(define
+  hk-trycatch-source
+  "parseInt :: String -> IO Int
+parseInt \"zero\" = return 0
+parseInt \"one\"  = return 1
+parseInt \"two\"  = return 2
+parseInt s = throwIO (SomeException (\"unknown: \" ++ s))
+
+describe :: Either SomeException Int -> String
+describe (Right v) = \"got \" ++ show v
+describe (Left (SomeException m)) = \"err: \" ++ m
+
+trial :: String -> IO String
+trial s = do
+  r <- try (parseInt s)
+  return (describe r)
+
+run3 :: String -> String -> String -> IO [String]
+run3 a b c = do
+  ra <- trial a
+  rb <- trial b
+  rc <- trial c
+  return [ra, rb, rc]
+
+")
+
+(hk-test
+  "trycatch.hs — Right branch"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = trial \"one\"")))
+  (list "IO" "got 1"))
+
+(hk-test
+  "trycatch.hs — Left branch with message"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = trial \"banana\"")))
+  (list "IO" "err: unknown: banana"))
+
+(hk-test
+  "trycatch.hs — chain over three inputs, all good"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = run3 \"zero\" \"one\" \"two\"")))
+  (list "IO"
+    (list ":" "got 0"
+      (list ":" "got 1"
+        (list ":" "got 2"
+          (list "[]"))))))
+
+(hk-test
+  "trycatch.hs — chain over three inputs, mixed"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source "main = run3 \"zero\" \"qux\" \"two\"")))
+  (list "IO"
+    (list ":" "got 0"
+      (list ":" "err: unknown: qux"
+        (list ":" "got 2"
+          (list "[]"))))))
+
+(hk-test
+  "trycatch.hs — Left from throwIO carries message"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = do { r <- try (throwIO (SomeException \"explicit\")); return (describe r) }")))
+  (list "IO" "err: explicit"))
+
+(hk-test
+  "trycatch.hs — Right preserves the int"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = do { r <- try (return 42); return (describe r) }")))
+  (list "IO" "got 42"))
+
+(hk-test
+  "trycatch.hs — pattern-bind on Right inside do"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = do { Right v <- try (parseInt \"two\"); return (v + 100) }")))
+  (list "IO" 102))
+
+(hk-test
+  "trycatch.hs — handle alias on parseInt failure"
+  (hk-deep-force
+    (hk-run
+      (str hk-trycatch-source
+        "main = handle (\\(SomeException m) -> return (\"caught: \" ++ m)) (parseInt \"nope\" >>= (\\v -> return (show v)))")))
+  (list "IO" "caught: unknown: nope"))

plans/haskell-completeness.md

@@ -292,21 +292,21 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 
 ### Phase 16 — Exception handling
 
-- [ ] `SomeException` type: `data SomeException = SomeException String`.
+- [x] `SomeException` type: `data SomeException = SomeException String`.
   `IOException = SomeException`.
-- [ ] `throwIO :: Exception e => e -> IO a` — raises `("hk-exception" e)`.
+- [x] `throwIO :: Exception e => e -> IO a` — raises `("hk-exception" e)`.
-- [ ] `evaluate :: a -> IO a` — forces arg strictly; any embedded `hk-error`
+- [x] `evaluate :: a -> IO a` — forces arg strictly; any embedded `hk-error`
   surfaces as a catchable `SomeException`.
-- [ ] `catch :: Exception e => IO a -> (e -> IO a) -> IO a` — wraps action in
+- [x] `catch :: Exception e => IO a -> (e -> IO a) -> IO a` — wraps action in
   SX `guard`; on `hk-error` or `hk-exception`, calls the handler with a
   `SomeException` value.
-- [ ] `try :: Exception e => IO a -> IO (Either e a)` — returns `Right v` on
+- [x] `try :: Exception e => IO a -> IO (Either e a)` — returns `Right v` on
   success, `Left e` on any exception.
-- [ ] `handle = flip catch`.
+- [x] `handle = flip catch`.
-- [ ] Tests in `lib/haskell/tests/exceptions.sx` (≥ 10 tests: catch success,
+- [x] Tests in `lib/haskell/tests/exceptions.sx` (≥ 10 tests: catch success,
   catch error, try Right, try Left, nested catch, evaluate surfaces error,
   throwIO propagates, handle alias).
-- [ ] Conformance programs:
+- [x] Conformance programs:
   - `safediv.hs` — safe division using `catch`; divide-by-zero raises,
     handler returns 0.
   - `trycatch.hs` — `try` pattern: run an action, branch on Left/Right.
@@ -315,6 +315,19 @@ No OCaml changes are needed. The view type is fully representable as an SX dict.
 
 _Newest first._
 
+**2026-05-08** — Phase 16 Exception handling complete (6 ops + module wiring +
+14 unit tests + 2 conformance programs). `hk-bind-exceptions!` in `eval.sx`
+registers `throwIO`, `throw`, `evaluate`, `catch`, `try`, `handle`, and
+`displayException`. `SomeException` constructor pre-registered in
+`runtime.sx`. `throwIO` and the `error` primitive both raise via SX `raise`
+with a uniform `"hk-error: msg"` string; catch/try/handle parse this string
+back into a `SomeException` via `hk-exception-of` (which strips nested
+`Unhandled exception: "..."` host wraps and the `hk-error: ` prefix). catch
+and handle evaluate the handler outside the guard scope, so a re-throw from
+the handler propagates past this catch (matching Haskell semantics, not an
+infinite loop). Phase 16 phase complete: scoreboard now 285/285 tests,
+36/36 programs.
+
 **2026-05-07** — Fix string ↔ `[Char]` equality. `reverse`/`length`/`head`/etc.
 on a string transparently coerce to a cons-list of char codes via `hk-str-head`
 + `hk-str-tail`, but `(==)` then compared the original raw string against the