Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 94dcd15e by Matthew Pickering at 2026-01-27T21:52:05-05:00 Evaluate backtraces for "error" exceptions at the moment they are thrown See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] which explain the implementation. This commit makes `error` and `throw` behave the same with regard to backtraces. Previously, exceptions raised by `error` would not contain useful IPE backtraces. I did try and implement `error` in terms of `throw` but it started to involve putting diverging functions into hs-boot files, which seemed to risky if the compiler wouldn't be able to see if applying a function would diverge. CLC proposal: https://github.com/haskell/core-libraries-committee/issues/383 Fixes #26751 - - - - - 9 changed files: - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Err.hs - libraries/ghc-internal/tests/stack-annotation/all.T - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs - + libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout - testsuite/tests/ghci.debugger/scripts/T8487.stdout - testsuite/tests/ghci.debugger/scripts/break011.stdout - testsuite/tests/ghci.debugger/scripts/break017.stdout - testsuite/tests/ghci.debugger/scripts/break025.stdout Changes: ===================================== libraries/base/changelog.md ===================================== @@ -24,6 +24,7 @@ * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329) * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376)) * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369)) + * Evaluate backtraces for "error" exceptions at the moment they are thrown. ([CLC proposal #383](https://github.com/haskell/core-libraries-committee/issues/383)) ## 4.22.0.0 *TBA* * Shipped with GHC 9.14.1 ===================================== libraries/ghc-internal/src/GHC/Internal/Err.hs ===================================== @@ -1,6 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude, MagicHash, ImplicitParams #-} {-# LANGUAGE RankNTypes, PolyKinds, DataKinds #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- @@ -25,6 +26,7 @@ module GHC.Internal.Err( absentErr, error, errorWithoutStackTrace, undefined ) where import GHC.Internal.Types (Char, RuntimeRep) import GHC.Internal.Stack.Types +import GHC.Internal.Magic import GHC.Internal.Prim import {-# SOURCE #-} GHC.Internal.Exception ( errorCallWithCallStackException @@ -33,7 +35,10 @@ import {-# SOURCE #-} GHC.Internal.Exception -- | 'error' stops execution and displays an error message. error :: forall (r :: RuntimeRep). forall (a :: TYPE r). HasCallStack => [Char] -> a -error s = raise# (errorCallWithCallStackException s ?callStack) +error s = + -- See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] + let !se = noinline (errorCallWithCallStackException s ?callStack) + in raise# se -- Bleh, we should be using 'GHC.Internal.Stack.callStack' instead of -- '?callStack' here, but 'GHC.Internal.Stack.callStack' depends on -- 'GHC.Internal.Stack.popCallStack', which is partial and depends on @@ -73,7 +78,10 @@ undefined :: forall (r :: RuntimeRep). forall (a :: TYPE r). -- nor wanted (see #19886). We’d like to use withFrozenCallStack, but that -- is not available in this module yet, and making it so is hard. So let’s just -- use raise# directly. -undefined = raise# (errorCallWithCallStackException "Prelude.undefined" ?callStack) +undefined = + -- See Note [Capturing the backtrace in throw] and Note [Hiding precise exception signature in throw] + let !se = noinline (errorCallWithCallStackException "Prelude.undefined" ?callStack) + in raise# se -- | Used for compiler-generated error message; -- encoding saves bytes of string junk. ===================================== libraries/ghc-internal/tests/stack-annotation/all.T ===================================== @@ -8,3 +8,4 @@ test('ann_frame001', ann_frame_opts, compile_and_run, ['']) test('ann_frame002', ann_frame_opts, compile_and_run, ['']) test('ann_frame003', ann_frame_opts, compile_and_run, ['']) test('ann_frame004', ann_frame_opts, compile_and_run, ['']) +test('ann_frame005', ann_frame_opts, compile_and_run, ['']) ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.hs ===================================== @@ -0,0 +1,73 @@ +import Control.Concurrent.STM +import Control.Exception +import Control.Exception.Backtrace (BacktraceMechanism(IPEBacktrace), setBacktraceMechanismState) +import Control.Exception.Context (displayExceptionContext) +import Control.Monad +import Data.List (isInfixOf) +import TestUtils + +data SimpleBoom = SimpleBoom deriving (Show) + +instance Exception SimpleBoom + +main :: IO () +main = do + setBacktraceMechanismState IPEBacktrace True + mapM_ (uncurry runCase) + [ ("throwIO SimpleBoom", throwIOAction) + , ("undefined", undefinedAction) + , ("error", errorAction) + , ("throwSTM", throwSTMAction) + ] + +runCase :: String -> IO () -> IO () +runCase label action = do + putStrLn ("=== " ++ label ++ " ===") + annotateCallStackIO $ + annotateStackStringIO ("catch site for " ++ label) $ + catch action (handler label) + +throwIOAction :: IO () +throwIOAction = + annotateStackStringIO "raising action" $ + annotateStackStringIO "throwIO SimpleBoom" $ + throwIO SimpleBoom + +undefinedAction :: IO () +undefinedAction = + annotateStackStringIO "raising undefined action" $ + void $ + evaluate $ + annotateStackString "undefined thunk" (undefined :: Int) + +errorAction :: IO () +errorAction = + annotateStackStringIO "raising error action" $ + void $ + evaluate $ + annotateStackString "error thunk" (error "error from annotateStackString" :: Int) + +throwSTMAction :: IO () +throwSTMAction = + annotateStackStringIO "raising throwSTM action" $ + atomically $ + annotateStackString "throwSTM SimpleBoom" $ + throwSTM SimpleBoom + +handler :: String -> SomeException -> IO () +handler label se = + annotateStackStringIO ("handler for " ++ label) $ + annotateStackStringIO ("forcing SomeException for " ++ label) $ do + message <- evaluate (displayException se) + putStrLn ("Caught exception: " ++ message) + let ctx = displayExceptionContext (someExceptionContext se) + ctxLines = lines ctx + putStrLn "Exception context:" + case ctxLines of + [] -> putStrLn "<empty>" + ls -> mapM_ (putStrLn . ("- " ++)) ls + let handlerTag = "handler for " ++ label + -- Check that the callstack is from the callsite, not the handling site + when (any (handlerTag `isInfixOf`) ctxLines) $ + error $ "handler annotation leaked into context for " ++ label + putStrLn "Handler annotation not present in context" ===================================== libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout ===================================== @@ -0,0 +1,45 @@ +=== throwIO SimpleBoom === +Caught exception: SimpleBoom +Exception context: +- IPE backtrace: +- throwIO SimpleBoom +- raising action +- catch site for throwIO SimpleBoom +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- throwIO, called at ann_frame005.hs:34:7 in main:Main +Handler annotation not present in context +=== undefined === +Caught exception: Prelude.undefined +Exception context: +- IPE backtrace: +- undefined thunk +- raising undefined action +- catch site for undefined +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- undefined, called at ann_frame005.hs:41:48 in main:Main +Handler annotation not present in context +=== error === +Caught exception: error from annotateStackString +Exception context: +- IPE backtrace: +- error thunk +- raising error action +- catch site for error +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- error, called at ann_frame005.hs:48:44 in main:Main +Handler annotation not present in context +=== throwSTM === +Caught exception: SimpleBoom +Exception context: +- IPE backtrace: +- raising throwSTM action +- catch site for throwSTM +- annotateCallStackIO, called at ann_frame005.hs:26:3 in main:Main +- HasCallStack backtrace: +- collectExceptionAnnotation, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:170:37 in ghc-internal:GHC.Internal.Exception +- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/STM.hs:190:26 in ghc-internal:GHC.Internal.STM +- throwSTM, called at ann_frame005.hs:55:9 in main:Main +Handler annotation not present in context ===================================== testsuite/tests/ghci.debugger/scripts/T8487.stdout ===================================== @@ -1,4 +1,5 @@ Breakpoint 0 activated at T8487.hs:(5,8)-(7,53) Stopped in Main.f, T8487.hs:(5,8)-(7,53) _result :: IO String = _ -ma :: Either SomeException String = Left _ +ma :: Either SomeException String = Left + (SomeException (ErrorCall ...)) ===================================== testsuite/tests/ghci.debugger/scripts/break011.stdout ===================================== @@ -4,9 +4,10 @@ HasCallStack backtrace: error, called at <interactive>:2:1 in interactive:Ghci1 Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = GHC.Internal.Exception.Type.SomeException + (GHC.Internal.Exception.ErrorCall _) Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = SomeException (ErrorCall _) -1 : main (Test7.hs:2:18-28) -2 : main (Test7.hs:2:8-29) <end of history> @@ -26,7 +27,7 @@ _exception :: SomeException = SomeException (ErrorCall "foo") *** Exception: foo HasCallStack backtrace: - error, called at Test7.hs:2:18 in main:Main + error, called at Test7.hs:2:18 in interactive-session:Main Stopped in <exception thrown>, <unknown> _exception :: e = _ @@ -35,5 +36,5 @@ _exception :: e = _ *** Exception: foo HasCallStack backtrace: - error, called at Test7.hs:2:18 in main:Main + error, called at Test7.hs:2:18 in interactive-session:Main ===================================== testsuite/tests/ghci.debugger/scripts/break017.stdout ===================================== @@ -1,5 +1,6 @@ "Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = GHC.Internal.Exception.Type.SomeException + (GHC.Internal.Exception.ErrorCall _) Logged breakpoint at QSort.hs:6:32-34 _result :: Char -> Bool a :: Char ===================================== testsuite/tests/ghci.debugger/scripts/break025.stdout ===================================== @@ -1,3 +1,4 @@ Stopped in <exception thrown>, <unknown> -_exception :: e = _ +_exception :: e = GHC.Internal.Exception.Type.SomeException + (GHC.Internal.Exception.ErrorCall _) () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94dcd15e54146abecf9b4f5e47d258ca... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94dcd15e54146abecf9b4f5e47d258ca... You're receiving this email because of your account on gitlab.haskell.org.