GitLab

Matthew Pickering pushed to branch wip/on-exception-annotate at Glasgow Haskell Compiler / GHC

Commits:

642000be

by Matthew Pickering at 2026-03-10T16:12:33+00:00

exceptions: annotate onException continuation with WhileHandling

Before this patch, an exception thrown in the `onException` handler
would loose track of where the original exception was thrown.

```
import Control.Exception

main :: IO ()
main = failingAction `onException` failingCleanup
  where
    failingAction = throwIO (ErrorCall "outer failure")
    failingCleanup = throwIO (ErrorCall "cleanup failure")
```

would report

```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:

cleanup failure

HasCallStack backtrace:
  throwIO, called at T28399.hs:<line>:<column> in <package-id>:Main
```

notice that the "outer failure" exception is not present in the error
message.

With this patch, any exception thrown is in the handler is annotated
with WhileHandling. The resulting message looks like

```
T28399: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:

cleanup failure

While handling outer failure

HasCallStack backtrace:
  throwIO, called at T28399.hs:7:22 in main:Main
```

CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/397

Fixes #26759

9 changed files:

libraries/base/changelog.md
libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs
libraries/ghc-internal/src/GHC/Internal/IO.hs
+ testsuite/tests/exceptions/T26759.hs
+ testsuite/tests/exceptions/T26759.stderr
+ testsuite/tests/exceptions/T26759a.hs
+ testsuite/tests/exceptions/T26759a.stderr
+ testsuite/tests/exceptions/T26759a.stdout
testsuite/tests/exceptions/all.T

Changes:

libraries/base/changelog.md

@@ -27,6 +27,7 @@
    * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383))
    * Hide implementation details when throwing exceptions in throw and throwSTM. ([CLC proposal #387](https://github.com/haskell/core-libraries-committee/issues/387))
    * Change `hIsReadable` and `hIsWritable` such that they always throw a respective exception when encountering a closed or semi-closed handle, not just in the case of a file handle. ([CLC proposal #371](github.com/haskell/core-libraries-committee/issues/371))
 +  * Annotate `onException` continuation with `WhileHandling`. ([CLC Proposal #397](https://github.com/haskell/core-libraries-committee/issues/397))
  ## 4.22.0.0 *TBA*
    * Shipped with GHC 9.14.1

libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs

@@ -203,7 +203,7 @@ tryJust p a = catchJust p (Right `fmap` a) (return . Left)
  -- exception raised by the computation.
  onException :: IO a -> IO b -> IO a
  onException io what = io `catchNoPropagate` \e -> do
 -                        _ <- what
 +                        _ <- annotateIO (whileHandling e) what
                          rethrowIO (e :: ExceptionWithContext SomeException)
  -----------------------------------------------------------------------------

libraries/ghc-internal/src/GHC/Internal/IO.hs

@@ -52,7 +52,7 @@ module GHC.Internal.IO (
  import GHC.Internal.Base
  import GHC.Internal.ST
  import GHC.Internal.Exception
 -import GHC.Internal.Exception.Type (NoBacktrace(..), WhileHandling(..), HasExceptionContext, ExceptionWithContext(..))
 +import GHC.Internal.Exception.Type (NoBacktrace(..), whileHandling, WhileHandling(..), HasExceptionContext, ExceptionWithContext(..))
  import GHC.Internal.Show
  import GHC.Internal.IO.Unsafe
  import GHC.Internal.Unsafe.Coerce ( unsafeCoerce )
@@ -363,7 +363,7 @@ getMaskingState  = IO $ \s ->
  onException :: IO a -> IO b -> IO a
  onException io what = io `catchExceptionNoPropagate` \e -> do
 -    _ <- what
 +    _ <- annotateIO (whileHandling e) what
      rethrowIO (e :: ExceptionWithContext SomeException)
  -- | Executes an IO computation with asynchronous

testsuite/tests/exceptions/T26759.hs

 +import Control.Exception
++
 +run :: IO ()
 +run = failingAction `onException` failingCleanup
 +  where
 +    failingAction = throwIO (ErrorCall "outer failure")
 +    failingCleanup = throwIO (ErrorCall "cleanup failure")
++
 +main :: IO ()
 +main = run

testsuite/tests/exceptions/T26759.stderr

 +T26759: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
++
 +cleanup failure
++
 +While handling outer failure
++
 +HasCallStack backtrace:
 +  throwIO, called at T26759.hs:7:22 in main:Main
++

testsuite/tests/exceptions/T26759a.hs

 +import Control.Exception
++
 +run :: IO ()
 +run = failingAction `onException` cleanup
 +  where
 +    failingAction = throwIO (ErrorCall "outer failure")
 +    cleanup = putStrLn "cleanup"
++
 +main :: IO ()
 +main = run

testsuite/tests/exceptions/T26759a.stderr

 +T26759a: Uncaught exception ghc-internal:GHC.Internal.Exception.ErrorCall:
++
 +outer failure
++
 +HasCallStack backtrace:
 +  throwIO, called at T26759a.hs:6:21 in main:Main
++

testsuite/tests/exceptions/T26759a.stdout

+cleanup

testsuite/tests/exceptions/all.T

  test('T25052', normal, compile_and_run, [''])
+-
 +test('T26759', exit_code(1), compile_and_run, [''])
 +test('T26759a', exit_code(1), compile_and_run, [''])