[Git][ghc/ghc][wip/on-exception-annotate] exceptions: annotate onException continuation with WhileHandling

3 Feb 2026


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


Commits:
e5f071a4 by Matthew Pickering at 2026-02-03T10:49:34+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
```

Fixes #26759

- - - - -


8 changed files:

- 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/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
=====================================
@@ -0,0 +1,10 @@
+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
=====================================
@@ -0,0 +1,9 @@
+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
=====================================
@@ -0,0 +1,10 @@
+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
=====================================
@@ -0,0 +1,7 @@
+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
=====================================
@@ -0,0 +1 @@
+cleanup


=====================================
testsuite/tests/exceptions/all.T
=====================================
@@ -1,2 +1,3 @@
 test('T25052', normal, compile_and_run, [''])
-
+test('T26759', exit_code(1), compile_and_run, [''])
+test('T26759a', exit_code(1), compile_and_run, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5f071a445e97aa4bfea37fb3d6bdda8...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5f071a445e97aa4bfea37fb3d6bdda8...
You're receiving this email because of your account on gitlab.haskell.org.

    

Matthew Pickering (＠mpickering)

tags

participants (1)