Hannes Siebenhandl pushed to branch wip/fendor/backtraces-decoders at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • libraries/base/src/Control/Exception/Backtrace.hs
    ... ... @@ -54,6 +54,11 @@ module Control.Exception.Backtrace
    54 54 
         , Backtraces(..)
    55 55 
         , displayBacktraces
    56 56 
         , collectBacktraces
    57 
    +      -- * Collecting exception annotations (like backtraces)
    58 
    +    , CollectExceptionAnnotationMechanism
    59 
    +    , getCollectExceptionAnnotationMechanism
    60 
    +    , setCollectExceptionAnnotation
    61 
    +    , collectExceptionAnnotation
    57 62 
         ) where
    58 63
    59 64 
     import GHC.Internal.Exception.Backtrace

  • libraries/ghc-internal/src/GHC/Internal/Exception.hs
    ... ... @@ -70,7 +70,7 @@ import GHC.Internal.Show
    70 70 
     import GHC.Internal.Stack.Types
    71 71 
     import GHC.Internal.IO.Unsafe
    72 72 
     import {-# SOURCE #-} GHC.Internal.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc, withFrozenCallStack)
    73 
    -import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectBacktraces)
    73 
    +import {-# SOURCE #-} GHC.Internal.Exception.Backtrace (collectExceptionAnnotation)
    74 74 
     import GHC.Internal.Exception.Type
    75 75
    76 76 
     -- | Throw an exception.  Exceptions may be thrown from purely
    ... ... @@ -166,8 +166,8 @@ toExceptionWithBacktrace :: (HasCallStack, Exception e)
    166 166 
                              => e -> IO SomeException
    167 167 
     toExceptionWithBacktrace e
    168 168 
       | backtraceDesired e = do
    169 
    -      bt <- collectBacktraces
    170 
    -      return (addExceptionContext bt (toException e))
    169 
    +      ea <- collectExceptionAnnotation
    170 
    +      return (addExceptionContext ea (toException e))
    171 171 
       | otherwise = return (toException e)
    172 172
    173 173 
     -- | This is thrown when the user calls 'error'. The @String@ is the

  • libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
    ... ... @@ -12,7 +12,7 @@ import GHC.Internal.IO.Unsafe (unsafePerformIO)
    12 12 
     import GHC.Internal.Exception.Context
    13 13 
     import GHC.Internal.Ptr
    14 14 
     import GHC.Internal.Data.Maybe (fromMaybe)
    15 
    -import GHC.Internal.Stack.Types as GHC.Stack (CallStack)
    15 
    +import GHC.Internal.Stack.Types as GHC.Stack (CallStack, HasCallStack)
    16 16 
     import qualified GHC.Internal.Stack as HCS
    17 17 
     import qualified GHC.Internal.ExecutionStack.Internal as ExecStack
    18 18 
     import qualified GHC.Internal.Stack.CloneStack as CloneStack
    ... ... @@ -86,6 +86,40 @@ setBacktraceMechanismState bm enabled = do
    86 86 
         _ <- atomicModifyIORef'_ enabledBacktraceMechanismsRef (setBacktraceMechanismEnabled bm enabled)
    87 87 
         return ()
    88 88
    89 
    +-- | How to collect 'ExceptionAnnotation's on throwing 'Exception's.
    90 
    +--
    91 
    +-- @since base-4.23.0.0
    92 
    +data CollectExceptionAnnotationMechanism = CollectExceptionAnnotationMechanism
    93 
    +  { ceaCollectExceptionAnnotationMechanism :: HasCallStack => IO SomeExceptionAnnotation
    94 
    +  }
    95 
    +
    96 
    +defaultCollectExceptionAnnotationMechanism :: CollectExceptionAnnotationMechanism
    97 
    +defaultCollectExceptionAnnotationMechanism = CollectExceptionAnnotationMechanism
    98 
    +  { ceaCollectExceptionAnnotationMechanism = SomeExceptionAnnotation `fmap` collectBacktraces
    99 
    +  }
    100 
    +
    101 
    +collectExceptionAnnotationMechanismRef :: IORef CollectExceptionAnnotationMechanism
    102 
    +collectExceptionAnnotationMechanismRef =
    103 
    +    unsafePerformIO $ newIORef defaultCollectExceptionAnnotationMechanism
    104 
    +{-# NOINLINE collectExceptionAnnotationMechanismRef #-}
    105 
    +
    106 
    +-- | Returns the current callback for collecting 'ExceptionAnnotation's on throwing 'Exception's.
    107 
    +--
    108 
    +-- @since base-4.23.0.0
    109 
    +getCollectExceptionAnnotationMechanism :: IO CollectExceptionAnnotationMechanism
    110 
    +getCollectExceptionAnnotationMechanism = readIORef collectExceptionAnnotationMechanismRef
    111 
    +
    112 
    +-- | Set the callback for collecting an 'ExceptionAnnotation'.
    113 
    +--
    114 
    +-- @since base-4.23.0.0
    115 
    +setCollectExceptionAnnotation :: ExceptionAnnotation a => (HasCallStack => IO a) -> IO ()
    116 
    +setCollectExceptionAnnotation collector = do
    117 
    +  let cea = CollectExceptionAnnotationMechanism
    118 
    +        { ceaCollectExceptionAnnotationMechanism = fmap SomeExceptionAnnotation collector
    119 
    +        }
    120 
    +  _ <- atomicModifyIORef'_ collectExceptionAnnotationMechanismRef (const cea)
    121 
    +  return ()
    122 
    +
    89 123 
     -- | A collection of backtraces.
    90 124 
     data Backtraces =
    91 125 
         Backtraces {
    ... ... @@ -124,6 +158,15 @@ displayBacktraces bts = concat
    124 158 
     instance ExceptionAnnotation Backtraces where
    125 159 
         displayExceptionAnnotation = displayBacktraces
    126 160
    161 
    +-- | Collect 'SomeExceptionAnnotation' based on the configuration of the
    162 
    +-- global 'CollectExceptionAnnotationMechanism'.
    163 
    +--
    164 
    +-- @since base-4.23.0.0
    165 
    +collectExceptionAnnotation :: HasCallStack => IO SomeExceptionAnnotation
    166 
    +collectExceptionAnnotation = HCS.withFrozenCallStack $ do
    167 
    +  cea <- getCollectExceptionAnnotationMechanism
    168 
    +  ceaCollectExceptionAnnotationMechanism cea
    169 
    +
    127 170 
     -- | Collect a set of 'Backtraces'.
    128 171 
     collectBacktraces :: (?callStack :: CallStack) => IO Backtraces
    129 172 
     collectBacktraces = HCS.withFrozenCallStack $ do

  • libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs-boot
    ... ... @@ -5,11 +5,7 @@ module GHC.Internal.Exception.Backtrace where
    5 5
    6 6 
     import GHC.Internal.Base (IO)
    7 7 
     import GHC.Internal.Stack.Types (HasCallStack)
    8 
    -import GHC.Internal.Exception.Context (ExceptionAnnotation)
    9 
    -
    10 
    -data Backtraces
    11 
    -
    12 
    -instance ExceptionAnnotation Backtraces
    8 
    +import GHC.Internal.Exception.Context (SomeExceptionAnnotation)
    13 9
    14 10 
     -- For GHC.Exception
    15 
    -collectBacktraces :: HasCallStack => IO Backtraces
    11 
    +collectExceptionAnnotation :: HasCallStack => IO SomeExceptionAnnotation

  • libraries/ghc-internal/src/GHC/Internal/Exception/Context.hs
    ... ... @@ -99,6 +99,9 @@ displayExceptionContext (ExceptionContext anns0) = mconcat $ intersperse "\n" $
    99 99
    100 100 
     data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
    101 101
    102 
    +instance ExceptionAnnotation SomeExceptionAnnotation where
    103 
    +  displayExceptionAnnotation (SomeExceptionAnnotation ann) = displayExceptionAnnotation ann
    104 
    +
    102 105 
     -- | 'ExceptionAnnotation's are types which can decorate exceptions as
    103 106 
     -- 'ExceptionContext'.
    104 107 
     --

  • testsuite/tests/interface-stability/base-exports.stdout
    ... ... @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 326 
       data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot}
    327 
    +  type CollectExceptionAnnotationMechanism :: *
    328 
    +  data CollectExceptionAnnotationMechanism = ...
    327 329 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    330 
    +  collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation
    328 331 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 332 
       getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
    333 
    +  getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism
    330 334 
       setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO ()
    335 
    +  setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO ()
    331 336
    332 337 
     module Control.Exception.Base where
    333 338 
       -- Safety: Safe
    ... ... @@ -12288,6 +12293,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G
    12288 12293 
     instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
    12289 12294 
     instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’
    12290 12295 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’
    12296 
    +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’
    12291 12297 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
    12292 12298 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
    12293 12299 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’

  • testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
    ... ... @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 326 
       data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot}
    327 
    +  type CollectExceptionAnnotationMechanism :: *
    328 
    +  data CollectExceptionAnnotationMechanism = ...
    327 329 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    330 
    +  collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation
    328 331 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 332 
       getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
    333 
    +  getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism
    330 334 
       setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO ()
    335 
    +  setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO ()
    331 336
    332 337 
     module Control.Exception.Base where
    333 338 
       -- Safety: Safe
    ... ... @@ -15323,6 +15328,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G
    15323 15328 
     instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
    15324 15329 
     instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’
    15325 15330 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’
    15331 
    +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’
    15326 15332 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
    15327 15333 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
    15328 15334 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’

  • testsuite/tests/interface-stability/base-exports.stdout-mingw32
    ... ... @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 326 
       data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot}
    327 
    +  type CollectExceptionAnnotationMechanism :: *
    328 
    +  data CollectExceptionAnnotationMechanism = ...
    327 329 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    330 
    +  collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation
    328 331 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 332 
       getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
    333 
    +  getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism
    330 334 
       setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO ()
    335 
    +  setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO ()
    331 336
    332 337 
     module Control.Exception.Base where
    333 338 
       -- Safety: Safe
    ... ... @@ -12547,6 +12552,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G
    12547 12552 
     instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
    12548 12553 
     instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’
    12549 12554 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’
    12555 
    +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’
    12550 12556 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
    12551 12557 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
    12552 12558 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’

  • testsuite/tests/interface-stability/base-exports.stdout-ws-32
    ... ... @@ -324,10 +324,15 @@ module Control.Exception.Backtrace where
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 326 
       data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe GHC.Internal.ExecutionStack.Internal.StackTrace, btrIpe :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.CloneStack.StackSnapshot}
    327 
    +  type CollectExceptionAnnotationMechanism :: *
    328 
    +  data CollectExceptionAnnotationMechanism = ...
    327 329 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    330 
    +  collectExceptionAnnotation :: GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO GHC.Internal.Exception.Context.SomeExceptionAnnotation
    328 331 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 332 
       getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
    333 
    +  getCollectExceptionAnnotationMechanism :: GHC.Internal.Types.IO CollectExceptionAnnotationMechanism
    330 334 
       setBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.Bool -> GHC.Internal.Types.IO ()
    335 
    +  setCollectExceptionAnnotation :: forall a. GHC.Internal.Exception.Context.ExceptionAnnotation a => (GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Types.IO a) -> GHC.Internal.Types.IO ()
    331 336
    332 337 
     module Control.Exception.Base where
    333 338 
       -- Safety: Safe
    ... ... @@ -12288,6 +12293,7 @@ instance GHC.Internal.Enum.Enum GHC.Internal.IO.IOMode.IOMode -- Defined in ‘G
    12288 12293 
     instance GHC.Internal.Enum.Enum GHC.Internal.IO.SubSystem.IoSubSystem -- Defined in ‘GHC.Internal.IO.SubSystem’
    12289 12294 
     instance GHC.Internal.Enum.Enum GHC.RTS.Flags.IoManagerFlag -- Defined in ‘GHC.RTS.Flags’
    12290 12295 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Type.WhileHandling -- Defined in ‘GHC.Internal.Exception.Type’
    12296 
    +instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Context.SomeExceptionAnnotation -- Defined in ‘GHC.Internal.Exception.Context’
    12291 12297 
     instance GHC.Internal.Exception.Context.ExceptionAnnotation GHC.Internal.Exception.Backtrace.Backtraces -- Defined in ‘GHC.Internal.Exception.Backtrace’
    12292 12298 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.AllocationLimitExceeded -- Defined in ‘GHC.Internal.IO.Exception’
    12293 12299 
     instance GHC.Internal.Exception.Type.Exception GHC.Internal.IO.Exception.ArrayException -- Defined in ‘GHC.Internal.IO.Exception’

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help