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
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:
105
lib/haskell/tests/exceptions.sx
Normal file
105
lib/haskell/tests/exceptions.sx
Normal 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))
|
||||
Reference in New Issue
Block a user