[Git][ghc/ghc][wip/exception-context] 7 commits: base: Introduce exception context

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Thu Oct 20 20:28:37 UTC 2022



Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC


Commits:
8ec96916 by Ben Gamari at 2022-10-20T16:28:29-04:00
base: Introduce exception context

- - - - -
18f0370f by Ben Gamari at 2022-10-20T16:28:29-04:00
base: Introduce exception backtrace infrastructure

- - - - -
4e881777 by Ben Gamari at 2022-10-20T16:28:30-04:00
base: Collect backtraces in GHC.IO.throwIO

- - - - -
acceab15 by Ben Gamari at 2022-10-20T16:28:30-04:00
base: Collect backtraces in GHC.Exception.throw

- - - - -
2600e7c7 by Ben Gamari at 2022-10-20T16:28:30-04:00
base: Force thrown toException applicatoins

This ensures that exceptions can be reliably inspected in GHCi.

- - - - -
6f33057a by Ben Gamari at 2022-10-20T16:28:30-04:00
Update test output

- - - - -
c91ce67d by Ben Gamari at 2022-10-20T16:28:30-04:00
base: Add HasCallStack constraints to io{Error,Exception}

This allows us to provide more useful HasCallStack backtraces from these
exception sources.

- - - - -


23 changed files:

- docs/users_guide/9.6.1-notes.rst
- libraries/base/Control/Exception.hs
- libraries/base/Control/Exception/Base.hs
- libraries/base/GHC/Exception.hs
- + libraries/base/GHC/Exception/Backtrace.hs
- + libraries/base/GHC/Exception/Backtrace.hs-boot
- + libraries/base/GHC/Exception/Context.hs
- + libraries/base/GHC/Exception/Context.hs-boot
- libraries/base/GHC/Exception/Type.hs
- libraries/base/GHC/IO.hs
- libraries/base/GHC/IO/Exception.hs
- libraries/base/GHC/Stack/CCS.hs-boot
- libraries/base/GHC/Stack/CloneStack.hs
- libraries/base/System/Timeout.hs
- libraries/base/base.cabal
- libraries/base/changelog.md
- libraries/base/tests/IO/T21336/T21336a.stderr
- libraries/base/tests/IO/T21336/T21336b.stderr
- libraries/base/tests/T13167.stderr
- testsuite/tests/ghci.debugger/scripts/T14690.stdout
- testsuite/tests/ghci.debugger/scripts/break024.stdout
- testsuite/tests/typecheck/should_compile/holes.stderr
- testsuite/tests/typecheck/should_compile/holes3.stderr


Changes:

=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -130,6 +130,17 @@ Runtime system
 ``base`` library
 ~~~~~~~~~~~~~~~~
 
+- Exceptions can now carry arbitrary user-defined annotations via the new
+  :base-ref:`GHC.Exception.Type.ExceptionContext` implicit parameter of
+  ``SomeException``. These annotations are intended to be used to carry
+  context describing the provenance of an exception.
+
+- GHC now collects backtraces for synchronous exceptions. These are carried by
+  the exception via the ``ExceptionContext`` mechanism described above.
+  GHC supports several mechanisms by which backtraces can be collected which
+  can be individually enabled and disabled via
+  :base-ref:`GHC.Exception.Backtrace.setEnabledBacktraceMechanisms`.
+
 - Exceptions thrown by weak pointer finalizers are now caught and reported
   via a global exception handler. By default this handler reports the error
   to ``stderr`` although this can be changed using


=====================================
libraries/base/Control/Exception.hs
=====================================
@@ -43,6 +43,7 @@ module Control.Exception (
         SomeAsyncException(..),
         AsyncException(..),     -- instance Eq, Ord, Show, Typeable, Exception
         asyncExceptionToException, asyncExceptionFromException,
+        asyncExceptionToExceptionWithContext,
 
         NonTermination(..),
         NestedAtomically(..),


=====================================
libraries/base/Control/Exception/Base.hs
=====================================
@@ -26,7 +26,7 @@ module Control.Exception.Base (
         ArrayException(..),
         AssertionFailed(..),
         SomeAsyncException(..), AsyncException(..),
-        asyncExceptionToException, asyncExceptionFromException,
+        asyncExceptionToException, asyncExceptionToExceptionWithContext, asyncExceptionFromException,
         NonTermination(..),
         NestedAtomically(..),
         BlockedIndefinitelyOnMVar(..),


=====================================
libraries/base/GHC/Exception.hs
=====================================
@@ -4,7 +4,10 @@
            , MagicHash
            , PatternSynonyms
   #-}
-{-# LANGUAGE DataKinds, PolyKinds #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# OPTIONS_HADDOCK not-home #-}
 
 -----------------------------------------------------------------------------
@@ -41,6 +44,8 @@ import GHC.OldList
 import GHC.IO.Unsafe
 import {-# SOURCE #-} GHC.Stack.CCS
 import {-# SOURCE #-} GHC.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc)
+import {-# SOURCE #-} GHC.Exception.Backtrace (collectBacktraces)
+import GHC.Exception.Context
 import GHC.Exception.Type
 
 -- | Throw an exception.  Exceptions may be thrown from purely
@@ -49,8 +54,11 @@ import GHC.Exception.Type
 -- WARNING: You may want to use 'throwIO' instead so that your pure code
 -- stays exception-free.
 throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.
-         Exception e => e -> a
-throw e = raise# (toException e)
+         (?callStack :: CallStack, Exception e) => e -> a
+throw e =
+    let !context = unsafePerformIO collectBacktraces
+        !exc = toExceptionWithContext e context
+    in raise# exc
 
 -- | This is thrown when the user calls 'error'. The first @String@ is the
 -- argument given to 'error', second @String@ is the location.


=====================================
libraries/base/GHC/Exception/Backtrace.hs
=====================================
@@ -0,0 +1,104 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module GHC.Exception.Backtrace
+    ( -- * Backtrace mechanisms
+      BacktraceMechanism(..)
+    , setEnabledBacktraceMechanisms
+    , getEnabledBacktraceMechanisms
+      -- * Collecting backtraces
+    , collectBacktraces
+    , collectBacktrace
+    ) where
+
+import GHC.Base
+import Data.OldList
+import GHC.IORef
+import GHC.IO.Unsafe (unsafePerformIO)
+import GHC.Show (Show)
+import GHC.Exception.Context
+import GHC.Stack.Types (HasCallStack, CallStack)
+import qualified GHC.Stack as CallStack
+import qualified GHC.ExecutionStack as ExecStack
+import qualified GHC.Stack.CloneStack as CloneStack
+import qualified GHC.Stack.CCS as CCS
+
+-- | How to collect a backtrace when an exception is thrown.
+data BacktraceMechanism
+  = -- | collect cost-centre stack backtraces (only available when built with profiling)
+    CostCentreBacktraceMech
+  | -- | collect backtraces from native execution stack unwinding
+    ExecutionStackBacktraceMech -- TODO: unwind limit?
+  | -- | collect backtraces from Info Table Provenance Entries
+    IPEBacktraceMech
+  | -- | collect 'HasCallStack' backtraces
+    HasCallStackBacktraceMech
+  deriving (Eq, Show)
+
+enabledBacktraceMechanisms :: IORef [BacktraceMechanism]
+enabledBacktraceMechanisms = unsafePerformIO $ newIORef [HasCallStackBacktraceMech]
+{-# NOINLINE enabledBacktraceMechanisms #-}
+
+-- | Set how 'Control.Exception.throwIO', et al. collect backtraces.
+setEnabledBacktraceMechanisms :: [BacktraceMechanism] -> IO ()
+setEnabledBacktraceMechanisms = writeIORef enabledBacktraceMechanisms
+
+-- | Returns the currently enabled 'BacktraceMechanism's.
+getEnabledBacktraceMechanisms :: IO [BacktraceMechanism]
+getEnabledBacktraceMechanisms = readIORef enabledBacktraceMechanisms
+
+collectBacktraces :: HasCallStack => IO ExceptionContext
+collectBacktraces = do
+    mechs <- getEnabledBacktraceMechanisms
+    mconcat `fmap` mapM collectBacktrace mechs
+
+data CostCentreBacktrace = CostCentreBacktrace [String]
+    deriving (Show)
+
+instance ExceptionAnnotation CostCentreBacktrace where
+    displayExceptionAnnotation (CostCentreBacktrace strs) = CCS.renderStack strs
+
+data ExecutionBacktrace = ExecutionBacktrace String
+    deriving (Show)
+
+instance ExceptionAnnotation ExecutionBacktrace where
+    displayExceptionAnnotation (ExecutionBacktrace str) =
+        "Native stack backtrace:\n" ++ str
+
+data HasCallStackBacktrace = HasCallStackBacktrace CallStack
+    deriving (Show)
+
+instance ExceptionAnnotation HasCallStackBacktrace where
+    displayExceptionAnnotation (HasCallStackBacktrace cs) =
+        "HasCallStack backtrace:\n" ++ CallStack.prettyCallStack cs
+
+data InfoProvBacktrace = InfoProvBacktrace [CloneStack.StackEntry]
+    deriving (Show)
+
+instance ExceptionAnnotation InfoProvBacktrace where
+    displayExceptionAnnotation (InfoProvBacktrace stack) =
+        "Info table provenance backtrace:\n" ++
+        intercalate "\n" (map ("    "++) $ map CloneStack.prettyStackEntry stack)
+
+collectBacktrace :: (?callStack :: CallStack) => BacktraceMechanism -> IO ExceptionContext
+collectBacktrace CostCentreBacktraceMech = do
+    strs <- CCS.currentCallStack
+    case strs of
+      [] -> return emptyExceptionContext
+      _  -> pure $ mkExceptionContext (CostCentreBacktrace strs)
+
+collectBacktrace ExecutionStackBacktraceMech = do
+    mst <- ExecStack.showStackTrace
+    case mst of
+      Nothing -> return emptyExceptionContext
+      Just st -> return $ mkExceptionContext (ExecutionBacktrace st)
+
+collectBacktrace IPEBacktraceMech = do
+    stack <- CloneStack.cloneMyStack
+    stackEntries <- CloneStack.decode stack
+    return $ mkExceptionContext (InfoProvBacktrace stackEntries)
+
+collectBacktrace HasCallStackBacktraceMech =
+    return $ mkExceptionContext (HasCallStackBacktrace ?callStack)
+


=====================================
libraries/base/GHC/Exception/Backtrace.hs-boot
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Exception.Backtrace where
+
+import GHC.Base (IO)
+import GHC.Exception.Context (ExceptionContext)
+import GHC.Stack.Types (HasCallStack)
+
+data BacktraceMechanism
+
+collectBacktraces :: HasCallStack => IO ExceptionContext


=====================================
libraries/base/GHC/Exception/Context.hs
=====================================
@@ -0,0 +1,77 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Exception.Context
+-- Copyright   :  (c) The University of Glasgow, 1998-2002
+-- License     :  see libraries/base/LICENSE
+--
+-- Maintainer  :  cvs-ghc at haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- Exception context type.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Exception.Context
+    ( -- * Exception context
+      ExceptionContext(..)
+    , emptyExceptionContext
+    , mkExceptionContext
+    , mergeExceptionContexts
+      -- * Exception annotations
+    , SomeExceptionAnnotation(..)
+    , ExceptionAnnotation(..)
+    ) where
+
+import GHC.Base ((++), String, Semigroup(..), Monoid(..))
+import GHC.Show (Show(..))
+import Data.Typeable.Internal (Typeable)
+
+-- | Exception context represents a list of 'ExceptionAnnotation's. These are
+-- attached to 'SomeException's via 'Control.Exception.addExceptionContext' and
+-- can be used to capture various ad-hoc metadata about the exception including
+-- backtraces and application-specific context.
+--
+-- 'ExceptionContext's can be merged via concatenation using the 'Semigroup'
+-- instance or 'mergeExceptionContexts'.
+data ExceptionContext = ExceptionContext [SomeExceptionAnnotation]
+    deriving (Show)
+
+instance Semigroup ExceptionContext where
+    (<>) = mergeExceptionContexts
+
+instance Monoid ExceptionContext where
+    mempty = emptyExceptionContext
+
+-- | An 'ExceptionContext' containing no annotations.
+emptyExceptionContext :: ExceptionContext
+emptyExceptionContext = ExceptionContext []
+
+-- | Construct a singleton 'ExceptionContext' from an 'ExceptionAnnotation'.
+mkExceptionContext :: ExceptionAnnotation a => a -> ExceptionContext
+mkExceptionContext x = ExceptionContext [SomeExceptionAnnotation x]
+
+-- | Merge two 'ExceptionContext's via concatenation
+mergeExceptionContexts :: ExceptionContext -> ExceptionContext -> ExceptionContext
+mergeExceptionContexts (ExceptionContext a) (ExceptionContext b) = ExceptionContext (a ++ b)
+
+
+data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
+
+instance Show SomeExceptionAnnotation where
+    showsPrec p (SomeExceptionAnnotation e) = showsPrec p e
+
+-- | 'ExceptionAnnotation's are types which can decorate exceptions as
+-- 'ExceptionContext'.
+class (Show a, Typeable a) => ExceptionAnnotation a where
+    -- | Render the annotation for display to the user.
+    displayExceptionAnnotation :: a -> String
+
+    default displayExceptionAnnotation :: Show a => a -> String
+    displayExceptionAnnotation = show
+


=====================================
libraries/base/GHC/Exception/Context.hs-boot
=====================================
@@ -0,0 +1,6 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Exception.Context where
+
+data ExceptionContext
+


=====================================
libraries/base/GHC/Exception/Type.hs
=====================================
@@ -1,5 +1,6 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE Trustworthy #-}
 
 {-# OPTIONS_HADDOCK not-home #-}
@@ -20,7 +21,16 @@
 
 module GHC.Exception.Type
        ( Exception(..)    -- Class
-       , SomeException(..), ArithException(..)
+       , SomeException(..)
+       , exceptionContext
+       , addExceptionContext
+         -- * Exception context
+       , ExceptionContext(..)
+       , emptyExceptionContext
+       , mergeExceptionContexts
+       , ExceptionWithContext(..)
+         -- * Arithmetic exceptions
+       , ArithException(..)
        , divZeroException, overflowException, ratioZeroDenomException
        , underflowException
        ) where
@@ -30,13 +40,24 @@ import Data.Typeable (Typeable, cast)
    -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
 import GHC.Base
 import GHC.Show
+import GHC.Exception.Context
 
 {- |
 The @SomeException@ type is the root of the exception type hierarchy.
 When an exception of type @e@ is thrown, behind the scenes it is
 encapsulated in a @SomeException at .
 -}
-data SomeException = forall e . Exception e => SomeException e
+data SomeException = forall e. (Exception e, ?context :: ExceptionContext) => SomeException e
+
+-- | View the 'ExceptionContext' of a 'SomeException'.
+exceptionContext :: SomeException -> ExceptionContext
+exceptionContext (SomeException _) = ?context
+
+-- | Add more 'ExceptionContext' to a 'SomeException'.
+addExceptionContext :: ExceptionContext -> SomeException -> SomeException
+addExceptionContext ctxt' se@(SomeException e) =
+    let ?context = exceptionContext se `mergeExceptionContexts` ctxt'
+    in SomeException e
 
 -- | @since 3.0
 instance Show SomeException where
@@ -129,10 +150,13 @@ Caught MismatchedParentheses
 
 -}
 class (Typeable e, Show e) => Exception e where
-    toException   :: e -> SomeException
+    toException            :: e -> SomeException
+    toExceptionWithContext :: e -> ExceptionContext -> SomeException
     fromException :: SomeException -> Maybe e
 
-    toException = SomeException
+    toException e = toExceptionWithContext e emptyExceptionContext
+    toExceptionWithContext e ctxt = SomeException e
+      where ?context = ctxt
     fromException (SomeException e) = cast e
 
     -- | Render this exception value in a human-friendly manner.
@@ -146,8 +170,31 @@ class (Typeable e, Show e) => Exception e where
 -- | @since 3.0
 instance Exception SomeException where
     toException se = se
+    toExceptionWithContext se ctxt = addExceptionContext ctxt se
     fromException = Just
-    displayException (SomeException e) = displayException e
+    displayException (SomeException e) =
+        displayException e ++ "\n" ++ displayContext ?context
+
+displayContext :: ExceptionContext -> String
+displayContext (ExceptionContext anns0) = go anns0
+  where
+    go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns
+    go [] = "\n"
+
+-- | Wraps a particular exception exposing its 'ExceptionContext'. Intended to
+-- be used when 'catch'ing exceptions in cases where access to the context is
+-- desired.
+data ExceptionWithContext a = ExceptionWithContext ExceptionContext a
+    deriving (Show)
+
+instance Exception a => Exception (ExceptionWithContext a) where
+    toException (ExceptionWithContext ctxt e) =
+        SomeException e
+      where ?context = ctxt
+    fromException se = do
+        e <- fromException se
+        return (ExceptionWithContext (exceptionContext se) e)
+    displayException = displayException . toException
 
 -- |Arithmetic exceptions.
 data ArithException


=====================================
libraries/base/GHC/IO.hs
=====================================
@@ -47,8 +47,10 @@ import GHC.ST
 import GHC.Exception
 import GHC.Show
 import GHC.IO.Unsafe
+import GHC.Stack.Types ( HasCallStack )
 import Unsafe.Coerce ( unsafeCoerce )
 
+import {-# SOURCE #-} GHC.Exception.Backtrace ( collectBacktraces )
 import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
 
 -- ---------------------------------------------------------------------------
@@ -235,8 +237,11 @@ mplusIO m n = m `catchException` \ (_ :: IOError) -> n
 -- for a more technical introduction to how GHC optimises around precise vs.
 -- imprecise exceptions.
 --
-throwIO :: Exception e => e -> IO a
-throwIO e = IO (raiseIO# (toException e))
+throwIO :: (HasCallStack, Exception e) => e -> IO a
+throwIO e = do
+    ctxt <- collectBacktraces
+    let !exc = toExceptionWithContext e ctxt
+    IO (raiseIO# exc)
 
 -- -----------------------------------------------------------------------------
 -- Controlling asynchronous exception delivery


=====================================
libraries/base/GHC/IO/Exception.hs
=====================================
@@ -28,7 +28,7 @@ module GHC.IO.Exception (
   cannotCompactFunction, cannotCompactPinned, cannotCompactMutable,
 
   SomeAsyncException(..),
-  asyncExceptionToException, asyncExceptionFromException,
+  asyncExceptionToException, asyncExceptionToExceptionWithContext, asyncExceptionFromException,
   AsyncException(..), stackOverflow, heapOverflow,
 
   ArrayException(..),
@@ -56,6 +56,7 @@ import GHC.Exception
 import GHC.IO.Handle.Types
 import GHC.OldList ( intercalate )
 import {-# SOURCE #-} GHC.Stack.CCS
+import GHC.Stack.Types (HasCallStack)
 import Foreign.C.Types
 
 import Data.Typeable ( cast )
@@ -183,18 +184,22 @@ instance Show SomeAsyncException where
 -- | @since 4.7.0.0
 instance Exception SomeAsyncException
 
--- |@since 4.7.0.0
+-- | @since 4.7.0.0
 asyncExceptionToException :: Exception e => e -> SomeException
 asyncExceptionToException = toException . SomeAsyncException
 
--- |@since 4.7.0.0
+-- | @since 4.18.0.0
+asyncExceptionToExceptionWithContext :: Exception e => e -> ExceptionContext -> SomeException
+asyncExceptionToExceptionWithContext e ctxt =
+    addExceptionContext ctxt (asyncExceptionToException e)
+
+-- | @since 4.7.0.0
 asyncExceptionFromException :: Exception e => SomeException -> Maybe e
 asyncExceptionFromException x = do
     SomeAsyncException a <- fromException x
     cast a
 
-
--- |Asynchronous exceptions.
+-- | Asynchronous exceptions.
 data AsyncException
   = StackOverflow
         -- ^The current thread\'s stack exceeded its limit.
@@ -233,6 +238,7 @@ data AsyncException
 -- | @since 4.7.0.0
 instance Exception AsyncException where
   toException = asyncExceptionToException
+  toExceptionWithContext = asyncExceptionToExceptionWithContext
   fromException = asyncExceptionFromException
 
 -- | Exceptions generated by array operations
@@ -305,11 +311,11 @@ data ExitCode
 -- | @since 4.1.0.0
 instance Exception ExitCode
 
-ioException     :: IOException -> IO a
+ioException     :: HasCallStack => IOException -> IO a
 ioException err = throwIO err
 
 -- | Raise an 'IOError' in the 'IO' monad.
-ioError         :: IOError -> IO a
+ioError         :: HasCallStack => IOError -> IO a
 ioError         =  ioException
 
 -- ---------------------------------------------------------------------------


=====================================
libraries/base/GHC/Stack/CCS.hs-boot
=====================================
@@ -14,3 +14,4 @@ module GHC.Stack.CCS where
 import GHC.Base
 
 currentCallStack :: IO [String]
+renderStack :: [String] -> String


=====================================
libraries/base/GHC/Stack/CloneStack.hs
=====================================
@@ -19,7 +19,8 @@ module GHC.Stack.CloneStack (
   StackEntry(..),
   cloneMyStack,
   cloneThreadStack,
-  decode
+  decode,
+  prettyStackEntry
   ) where
 
 import GHC.MVar
@@ -263,3 +264,7 @@ getDecodedStackArray (StackSnapshot s) =
     stackEntryAt :: Array# (Ptr InfoProvEnt) -> Int -> Ptr InfoProvEnt
     stackEntryAt stack (I# i) = case indexArray# stack i of
       (# se #) -> se
+
+prettyStackEntry :: StackEntry -> String
+prettyStackEntry (StackEntry {moduleName=mod_nm, functionName=fun_nm, srcLoc=loc}) =
+    "  " ++ mod_nm ++ "." ++ fun_nm ++ " (" ++ loc ++ ")"


=====================================
libraries/base/System/Timeout.hs
=====================================
@@ -27,6 +27,7 @@ import Control.Concurrent
 import Control.Exception   (Exception(..), handleJust, bracket,
                             uninterruptibleMask_,
                             asyncExceptionToException,
+                            asyncExceptionToExceptionWithContext,
                             asyncExceptionFromException)
 import Data.Unique         (Unique, newUnique)
 
@@ -52,6 +53,7 @@ instance Show Timeout where
 -- | @since 4.7.0.0
 instance Exception Timeout where
   toException = asyncExceptionToException
+  toExceptionWithContext = asyncExceptionToExceptionWithContext
   fromException = asyncExceptionFromException
 
 -- |Wrap an 'IO' computation to time out and return @Nothing@ in case no result


=====================================
libraries/base/base.cabal
=====================================
@@ -208,6 +208,8 @@ Library
         GHC.Err
         GHC.Event.TimeOut
         GHC.Exception
+        GHC.Exception.Backtrace
+        GHC.Exception.Context
         GHC.Exception.Type
         GHC.ExecutionStack
         GHC.ExecutionStack.Internal


=====================================
libraries/base/changelog.md
=====================================
@@ -2,6 +2,11 @@
 
 ## 4.18.0.0 *TBA*
 
+  * Exceptions now capture backtrace information via their `ExceptionContext`. GHC
+    supports several mechanisms by which backtraces can be collected which can be
+    individually enabled and disabled via
+    `GHC.Exception.Backtrace.setEnabledBacktraceMechanisms`.
+  * Exceptions can now be decorated with user-defined annotations via `ExceptionContext`.
   * Exceptions thrown by weak pointer finalizers are now reported via a global
     exception handler.
   * Add `GHC.Weak.Finalize.{get,set}FinalizerExceptionHandler` which the user to


=====================================
libraries/base/tests/IO/T21336/T21336a.stderr
=====================================
@@ -1 +1,15 @@
 Exception during Weak# finalization (ignored): GHC.IO.FD.fdWrite: resource exhausted (No space left on device)
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at libraries/base/GHC/IO/Exception.hs:315:19 in base:GHC.IO.Exception
+  ioException, called at libraries/base/GHC/IO/Exception.hs:319:20 in base:GHC.IO.Exception
+  ioError, called at libraries/base/Foreign/C/Error.hs:288:5 in base:Foreign.C.Error
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at libraries/base/GHC/IO/Handle/Internals.hs:446:17 in base:GHC.IO.Handle.Internals
+
+


=====================================
libraries/base/tests/IO/T21336/T21336b.stderr
=====================================
@@ -1 +1,10 @@
 Exception during Weak# finalization (ignored): <stdout>: hFlush: resource exhausted (No space left on device)
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at libraries/base/GHC/IO/Exception.hs:315:19 in base:GHC.IO.Exception
+  ioException, called at libraries/base/GHC/IO/Exception.hs:319:20 in base:GHC.IO.Exception
+  ioError, called at libraries/base/GHC/IO/Handle/Internals.hs:181:13 in base:GHC.IO.Handle.Internals
+
+


=====================================
libraries/base/tests/T13167.stderr
=====================================
@@ -1,4 +1,32 @@
 Exception during Weak# finalization (ignored): failed
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at T13167.hs:23:5 in main:Main
+
+
 Exception during Weak# finalization (ignored): failed
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at T13167.hs:23:5 in main:Main
+
+
 Exception during Weak# finalization (ignored): failed
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at T13167.hs:23:5 in main:Main
+
+
 Exception during Weak# finalization (ignored): failed
+HasCallStack backtrace:
+CallStack (from HasCallStack):
+  collectBacktrace, called at libraries/base/GHC/Exception/Backtrace.hs:54:25 in base:GHC.Exception.Backtrace
+  collectBacktraces, called at libraries/base/GHC/IO.hs:242:13 in base:GHC.IO
+  throwIO, called at T13167.hs:23:5 in main:Main
+
+


=====================================
testsuite/tests/ghci.debugger/scripts/T14690.stdout
=====================================
@@ -1,10 +1,12 @@
 Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = GHC.Exception.Type.SomeException
+                    (GHC.Exception.ErrorCallWithLocation _ _)
 :steplocal is not possible.
 Cannot determine current top-level binding after a break on error / exception.
 Use :stepmodule.
 Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = GHC.Exception.Type.SomeException
+                    (GHC.Exception.ErrorCallWithLocation _ _)
 :steplocal is not possible.
 Cannot determine current top-level binding after a break on error / exception.
 Use :stepmodule.


=====================================
testsuite/tests/ghci.debugger/scripts/break024.stdout
=====================================
@@ -1,12 +1,14 @@
 Left user error (error)
 Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException
+                    (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....)
 _exception = SomeException
                (GHC.IO.Exception.IOError
                   Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing)
 *** Exception: user error (error)
 Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException
+                    (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....)
 _exception = SomeException
                (GHC.IO.Exception.IOError
                   Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing)
@@ -14,7 +16,8 @@ Stopped in <exception thrown>, <unknown>
 _exception :: e = SomeException
                     (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....)
 Stopped in <exception thrown>, <unknown>
-_exception :: e = _
+_exception :: e = SomeException
+                    (GHC.IO.Exception.IOError Nothing GHC.IO.Exception.UserError ....)
 _exception = SomeException
                (GHC.IO.Exception.IOError
                   Nothing GHC.IO.Exception.UserError [] "error" Nothing Nothing)


=====================================
testsuite/tests/typecheck/should_compile/holes.stderr
=====================================
@@ -92,7 +92,9 @@ holes.hs:11:15: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
         asTypeOf :: forall a. a -> a -> a
         id :: forall a. a -> a
         until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
-        ioError :: forall a. IOError -> IO a
+        ioError :: forall a.
+                   GHC.Stack.Types.HasCallStack =>
+                   IOError -> IO a
         (!!) :: forall a. GHC.Stack.Types.HasCallStack => [a] -> Int -> a
         break :: forall a. (a -> Bool) -> [a] -> ([a], [a])
         cycle :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a]


=====================================
testsuite/tests/typecheck/should_compile/holes3.stderr
=====================================
@@ -95,7 +95,9 @@ holes3.hs:11:15: error: [GHC-88464]
         asTypeOf :: forall a. a -> a -> a
         id :: forall a. a -> a
         until :: forall a. (a -> Bool) -> (a -> a) -> a -> a
-        ioError :: forall a. IOError -> IO a
+        ioError :: forall a.
+                   GHC.Stack.Types.HasCallStack =>
+                   IOError -> IO a
         (!!) :: forall a. GHC.Stack.Types.HasCallStack => [a] -> Int -> a
         break :: forall a. (a -> Bool) -> [a] -> ([a], [a])
         cycle :: forall a. GHC.Stack.Types.HasCallStack => [a] -> [a]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89e978867c7e8b69103bd19c0f34636082c7e4b1...c91ce67dd859e2e7597c648e96476894c10c03c7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89e978867c7e8b69103bd19c0f34636082c7e4b1...c91ce67dd859e2e7597c648e96476894c10c03c7
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221020/bf08be73/attachment-0001.html>


More information about the ghc-commits mailing list