haskell: Phase 16 — exception handling (catch/try/throwIO/evaluate/handle/throw)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s

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>
This commit is contained in:
2026-05-08 00:17:46 +00:00
parent 544e79f533
commit e83c01cdcc
9 changed files with 455 additions and 14 deletions

View File

@@ -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))

View File

@@ -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))

View File

@@ -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"))