[Git][ghc/ghc][wip/exception-context] 4 commits: base: Introduce exception context
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Wed May 10 21:40:44 UTC 2023
Ben Gamari pushed to branch wip/exception-context at Glasgow Haskell Compiler / GHC
Commits:
2264671d by Ben Gamari at 2023-05-10T17:40:25-04:00
base: Introduce exception context
- - - - -
df65ca1d by Ben Gamari at 2023-05-10T17:40:25-04:00
compiler: Default and warn ExceptionContext constraints
- - - - -
3e92a6bb by Ben Gamari at 2023-05-10T17:40:25-04:00
base: Introduce WhileHandling annotations
- - - - -
2d9ea503 by Ben Gamari at 2023-05-10T17:40:25-04:00
base: Don't collect backtraces in onException
- - - - -
26 changed files:
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Types/Error/Codes.hs
- docs/users_guide/9.8.1-notes.rst
- libraries/base/GHC/Conc/Sync.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/base.cabal
- libraries/base/changelog.md
- libraries/base/tests/IO/T21336/T21336a.stderr
- libraries/base/tests/IO/T21336/T21336b.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:
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -452,6 +452,10 @@ basicKnownKeyNames
-- Overloaded record fields
hasFieldClassName,
+ -- ExceptionContext
+ exceptionContextTyConName,
+ emptyExceptionContextName,
+
-- Call Stacks
callStackTyConName,
emptyCallStackName, pushCallStackName,
@@ -557,7 +561,8 @@ gHC_PRIM, gHC_PRIM_PANIC,
tYPEABLE, tYPEABLE_INTERNAL, gENERICS,
rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL,
aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, gHC_IS_LIST,
- cONTROL_EXCEPTION_BASE, gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL,
+ cONTROL_EXCEPTION_BASE, gHC_EXCEPTION_CONTEXT,
+ gHC_TYPEERROR, gHC_TYPELITS, gHC_TYPELITS_INTERNAL,
gHC_TYPENATS, gHC_TYPENATS_INTERNAL,
dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_CONSTPTR :: Module
@@ -619,6 +624,7 @@ rANDOM = mkBaseModule (fsLit "System.Random")
gHC_EXTS = mkBaseModule (fsLit "GHC.Exts")
gHC_IS_LIST = mkBaseModule (fsLit "GHC.IsList")
cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base")
+gHC_EXCEPTION_CONTEXT = mkBaseModule (fsLit "GHC.Exception.Context")
gHC_GENERICS = mkBaseModule (fsLit "GHC.Generics")
gHC_TYPEERROR = mkBaseModule (fsLit "GHC.TypeError")
gHC_TYPELITS = mkBaseModule (fsLit "GHC.TypeLits")
@@ -1618,6 +1624,13 @@ hasFieldClassName :: Name
hasFieldClassName
= clsQual gHC_RECORDS (fsLit "HasField") hasFieldClassNameKey
+-- ExceptionContext
+exceptionContextTyConName, emptyExceptionContextName :: Name
+exceptionContextTyConName =
+ tcQual gHC_EXCEPTION_CONTEXT (fsLit "ExceptionContext") exceptionContextTyConKey
+emptyExceptionContextName
+ = varQual gHC_EXCEPTION_CONTEXT (fsLit "emptyExceptionContext") emptyExceptionContextKey
+
-- Source Locations
callStackTyConName, emptyCallStackName, pushCallStackName,
srcLocDataConName :: Name
@@ -2085,6 +2098,9 @@ typeCharToNatTyFamNameKey = mkPreludeTyConUnique 415
typeNatToCharTyFamNameKey = mkPreludeTyConUnique 416
constPtrTyConKey = mkPreludeTyConUnique 417
+exceptionContextTyConKey :: Unique
+exceptionContextTyConKey = mkPreludeTyConUnique 420
+
{-
************************************************************************
* *
@@ -2535,6 +2551,9 @@ fromStaticPtrClassOpKey = mkPreludeMiscIdUnique 560
makeStaticKey :: Unique
makeStaticKey = mkPreludeMiscIdUnique 561
+emptyExceptionContextKey :: Unique
+emptyExceptionContextKey = mkPreludeMiscIdUnique 562
+
-- Unsafe coercion proofs
unsafeEqualityProofIdKey, unsafeCoercePrimIdKey :: Unique
unsafeEqualityProofIdKey = mkPreludeMiscIdUnique 570
=====================================
compiler/GHC/Core/Predicate.hs
=====================================
@@ -26,7 +26,8 @@ module GHC.Core.Predicate (
-- Implicit parameters
isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass,
- isCallStackTy, isCallStackPred, isCallStackPredTy,
+ isCallStackPred, isCallStackPredTy,
+ isExceptionContextPred,
isIPPred_maybe,
-- Evidence variables
@@ -292,6 +293,28 @@ has_ip_super_classes rec_clss cls tys
initIPRecTc :: RecTcChecker
initIPRecTc = setRecTcMaxBound 1 initRecTc
+-- --------------------- ExceptionContext predicates --------------------------
+
+-- | Is a 'PredType' an @ExceptionContext@ implicit parameter?
+--
+-- If so, return the name of the parameter.
+isExceptionContextPred :: Class -> [Type] -> Maybe FastString
+isExceptionContextPred cls tys
+ | [ty1, ty2] <- tys
+ , isIPClass cls
+ , isExceptionContextTy ty2
+ = isStrLitTy ty1
+ | otherwise
+ = Nothing
+
+-- | Is a type a 'CallStack'?
+isExceptionContextTy :: Type -> Bool
+isExceptionContextTy ty
+ | Just tc <- tyConAppTyCon_maybe ty
+ = tc `hasKey` exceptionContextTyConKey
+ | otherwise
+ = False
+
-- --------------------- CallStack predicates ---------------------------------
isCallStackPredTy :: Type -> Bool
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1406,6 +1406,17 @@ instance Diagnostic TcRnMessage where
hsep [ text "Unknown type variable" <> plural errorVars
, text "on the RHS of injectivity condition:"
, interpp'SP errorVars ]
+ TcRnDefaultedExceptionContext ct_loc ->
+ mkSimpleDecorated $ vcat [ header, warning, proposal ]
+ where
+ header, warning, proposal :: SDoc
+ header
+ = vcat [ text "Solving for an implicit ExceptionContext constraint"
+ , nest 2 $ pprCtOrigin (ctLocOrigin ct_loc) <> text "." ]
+ warning
+ = vcat [ text "Future versions of GHC will turn this warning into an error." ]
+ proposal
+ = vcat [ text "See GHC Proposal #330." ]
diagnosticReason = \case
TcRnUnknownMessage m
@@ -1870,6 +1881,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnUnknownTyVarsOnRhsOfInjCond{}
-> ErrorWithoutFlag
+ TcRnDefaultedExceptionContext{}
+ -> WarningWithoutFlag --WarningWithFlag TODO
diagnosticHints = \case
TcRnUnknownMessage m
@@ -2352,6 +2365,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnUnknownTyVarsOnRhsOfInjCond{}
-> noHints
+ TcRnDefaultedExceptionContext _
+ -> noHints
diagnosticCode = constructorCode
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -3178,6 +3178,14 @@ data TcRnMessage where
-}
TcRnUnknownTyVarsOnRhsOfInjCond :: [Name] -> TcRnMessage
+ {-| TcRnDefaultedExceptionContext is a warning that is triggered when the
+ backward-compatibility logic solving for implicit ExceptionContext
+ constraints fires.
+
+ Test cases: TODO
+ -}
+ TcRnDefaultedExceptionContext :: CtLoc -> TcRnMessage
+
deriving Generic
-- | Things forbidden in @type data@ declarations.
=====================================
compiler/GHC/Tc/Solver.hs
=====================================
@@ -52,16 +52,19 @@ import GHC.Tc.Solver.InertSet
import GHC.Tc.Solver.Monad as TcS
import GHC.Tc.Types.Constraint
import GHC.Tc.Instance.FunDeps
+import GHC.Core.InstEnv ( Coherence(..) )
import GHC.Core.Predicate
import GHC.Tc.Types.Origin
import GHC.Tc.Utils.TcType
import GHC.Core.Type
import GHC.Core.Ppr
+import GHC.Core (Expr(Var))
import GHC.Core.TyCon ( TyConBinder, isTypeFamilyTyCon )
import GHC.Builtin.Types ( liftedRepTy, liftedDataConTy )
import GHC.Core.Unify ( tcMatchTyKi )
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Types.TyThing ( MonadThings(lookupId) )
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Basic ( IntWithInf, intGtLimit
@@ -73,7 +76,8 @@ import Control.Monad
import Data.Foldable ( toList )
import Data.List ( partition )
import Data.List.NonEmpty ( NonEmpty(..) )
-import GHC.Data.Maybe ( mapMaybe, isJust )
+import GHC.Data.Maybe ( mapMaybe, isJust, runMaybeT, MaybeT )
+import Control.Monad.Trans.Class (lift)
{-
*********************************************************************************
@@ -534,46 +538,66 @@ simplifyTopWanteds wanteds
try_callstack_defaulting :: WantedConstraints -> TcS WantedConstraints
try_callstack_defaulting wc
- | isEmptyWC wc
- = return wc
- | otherwise
- = defaultCallStacks wc
+ = defaultConstraints [defaultCallStack, defaultExceptionContext] wc
+
+defaultExceptionContext :: Ct -> MaybeT TcS ()
+defaultExceptionContext ct
+ = do { ClassPred cls tys <- pure $ classifyPredType (ctPred ct)
+ ; Just {} <- pure $ isExceptionContextPred cls tys
+ ; emptyEC <- Var <$> lift (lookupId emptyExceptionContextName)
+ ; let ev = ctEvidence ct
+ ; let ev_tm = mkEvCast emptyEC (wrapIP (ctEvPred ev))
+ ; lift $ warnTcS $ TcRnDefaultedExceptionContext (ctLoc ct)
+ ; lift $ setEvBindIfWanted ev IsCoherent ev_tm
+ }
-- | Default any remaining @CallStack@ constraints to empty @CallStack at s.
-defaultCallStacks :: WantedConstraints -> TcS WantedConstraints
-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence
-defaultCallStacks wanteds
+defaultCallStack :: Ct -> MaybeT TcS ()
+defaultCallStack ct
+ = do { ClassPred cls tys <- pure $ classifyPredType (ctPred ct)
+ ; Just {} <- pure $ isCallStackPred cls tys
+ ; lift $ solveCallStack (ctEvidence ct) EvCsEmpty
+ }
+
+defaultConstraints :: [Ct -> MaybeT TcS ()]
+ -> WantedConstraints
+ -> TcS WantedConstraints
+-- See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence
+defaultConstraints defaulting_strategies wanteds
+ | isEmptyWC wanteds = return wanteds
+ | otherwise
= do simples <- handle_simples (wc_simple wanteds)
mb_implics <- mapBagM handle_implic (wc_impl wanteds)
return (wanteds { wc_simple = simples
, wc_impl = catBagMaybes mb_implics })
-
where
-
- handle_simples simples
- = catBagMaybes <$> mapBagM defaultCallStack simples
-
- handle_implic :: Implication -> TcS (Maybe Implication)
- -- The Maybe is because solving the CallStack constraint
- -- may well allow us to discard the implication entirely
- handle_implic implic
- | isSolvedStatus (ic_status implic)
- = return (Just implic)
- | otherwise
- = do { wanteds <- setEvBindsTcS (ic_binds implic) $
- -- defaultCallStack sets a binding, so
- -- we must set the correct binding group
- defaultCallStacks (ic_wanted implic)
- ; setImplicationStatus (implic { ic_wanted = wanteds }) }
-
- defaultCallStack ct
- | ClassPred cls tys <- classifyPredType (ctPred ct)
- , Just {} <- isCallStackPred cls tys
- = do { solveCallStack (ctEvidence ct) EvCsEmpty
- ; return Nothing }
-
- defaultCallStack ct
- = return (Just ct)
+ handle_simples :: Bag Ct -> TcS (Bag Ct)
+ handle_simples simples
+ = catBagMaybes <$> mapBagM handle_simple simples
+ where
+ handle_simple :: Ct -> TcS (Maybe Ct)
+ handle_simple ct = go defaulting_strategies
+ where
+ go [] = return (Just ct)
+ go (f:fs) = do
+ mb <- runMaybeT (f ct)
+ case mb of
+ Just () -> return Nothing
+ Nothing -> go fs
+
+ handle_implic :: Implication -> TcS (Maybe Implication)
+ -- The Maybe is because solving the CallStack constraint
+ -- may well allow us to discard the implication entirely
+ handle_implic implic
+ | isSolvedStatus (ic_status implic)
+ = return (Just implic)
+ | otherwise
+ = do { wanteds <- setEvBindsTcS (ic_binds implic) $
+ -- defaultCallStack sets a binding, so
+ -- we must set the correct binding group
+ defaultConstraints defaulting_strategies (ic_wanted implic)
+ ; setImplicationStatus (implic { ic_wanted = wanteds }) }
{- Note [When to do type-class defaulting]
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -530,6 +530,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnShadowedTyVarNameInFamResult" = 99412
GhcDiagnosticCode "TcRnIncorrectTyVarOnLhsOfInjCond" = 88333
GhcDiagnosticCode "TcRnUnknownTyVarsOnRhsOfInjCond" = 48254
+ GhcDiagnosticCode "TcRnDefaultedExceptionContext" = 46235
-- IllegalNewtypeReason
GhcDiagnosticCode "DoesNotHaveSingleField" = 23517
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -48,6 +48,17 @@ Runtime system
- ``Data.Tuple`` now exports ``getSolo :: Solo a -> a``.
+- 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`.
+
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/GHC/Conc/Sync.hs
=====================================
@@ -106,7 +106,6 @@ module GHC.Conc.Sync
import Foreign
import Foreign.C
-import Data.Typeable
import Data.Maybe
import GHC.Base
@@ -944,7 +943,7 @@ uncaughtExceptionHandler :: IORef (SomeException -> IO ())
uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)
where
defaultHandler :: SomeException -> IO ()
- defaultHandler se@(SomeException ex) = do
+ defaultHandler se = do
(hFlush stdout) `catchAny` (\ _ -> return ())
let msg = displayException se
withCString "%s" $ \cfmt ->
=====================================
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 #-}
-----------------------------------------------------------------------------
@@ -27,6 +30,7 @@ module GHC.Exception
, ErrorCall(..,ErrorCall)
, errorCallException
, errorCallWithCallStackException
+ , toExceptionWithBacktrace
-- * Re-exports from GHC.Types
, CallStack, fromCallSiteList, getCallStack, prettyCallStack
@@ -41,6 +45,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 +55,18 @@ 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 !se = unsafePerformIO (toExceptionWithBacktrace e)
+ in raise# se
+
+toExceptionWithBacktrace :: (HasCallStack, Exception e)
+ => e -> IO SomeException
+toExceptionWithBacktrace e
+ | backtraceDesired e = do
+ bt <- collectBacktraces
+ return (addExceptionContext bt (toException e))
+ | otherwise = return (toException e)
-- | This is thrown when the user calls 'error'. The first @String@ is the
-- argument given to 'error', second @String@ is the location.
@@ -84,7 +100,7 @@ errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do
implicitParamCallStack = prettyCallStackLines stk
ccsCallStack = showCCSStack ccsStack
stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
- return $ toException (ErrorCallWithLocation s stack)
+ toExceptionWithBacktrace (ErrorCallWithLocation s stack)
showCCSStack :: [String] -> [String]
showCCSStack [] = []
=====================================
libraries/base/GHC/Exception/Backtrace.hs
=====================================
@@ -0,0 +1,129 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE GADTs #-}
+
+module GHC.Exception.Backtrace
+ ( -- * Backtrace mechanisms
+ BacktraceMechanism(..)
+ , setEnabledBacktraceMechanisms
+ , getEnabledBacktraceMechanisms
+ -- * Collecting backtraces
+ , Backtraces
+ , getBacktrace
+ , collectBacktraces
+ , collectBacktrace
+ ) where
+
+import GHC.Base
+import Data.OldList
+import GHC.IORef
+import GHC.IO.Unsafe (unsafePerformIO)
+import GHC.Exception.Context
+import GHC.Stack.Types (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 rep where
+ -- | collect cost-centre stack backtraces (only available when built with profiling)
+ CostCentreBacktrace :: BacktraceMechanism [String] -- TODO: Proper representation
+ -- | collect backtraces from native execution stack unwinding
+ ExecutionStackBacktrace :: BacktraceMechanism String -- TODO: proper representation
+ -- | collect backtraces from Info Table Provenance Entries
+ IPEBacktrace :: BacktraceMechanism [CloneStack.StackEntry]
+ -- | collect 'HasCallStack' backtraces
+ HasCallStackBacktrace :: BacktraceMechanism CallStack
+
+newtype EnabledBacktraceMechanisms =
+ EnabledBacktraceMechanisms {
+ backtraceMechanismEnabled :: forall a. BacktraceMechanism a -> Bool
+ }
+
+defaultEnabledBacktraceMechanisms :: EnabledBacktraceMechanisms
+defaultEnabledBacktraceMechanisms = EnabledBacktraceMechanisms f
+ where
+ f HasCallStackBacktrace = True
+ f _ = False
+
+enabledBacktraceMechanisms :: IORef EnabledBacktraceMechanisms
+enabledBacktraceMechanisms =
+ unsafePerformIO $ newIORef defaultEnabledBacktraceMechanisms
+{-# NOINLINE enabledBacktraceMechanisms #-}
+
+-- | Set how 'Control.Exception.throwIO', et al. collect backtraces.
+setEnabledBacktraceMechanisms :: EnabledBacktraceMechanisms -> IO ()
+setEnabledBacktraceMechanisms = writeIORef enabledBacktraceMechanisms
+
+-- | Returns the currently enabled 'BacktraceMechanism's.
+getEnabledBacktraceMechanisms :: IO EnabledBacktraceMechanisms
+getEnabledBacktraceMechanisms = readIORef enabledBacktraceMechanisms
+
+newtype Backtraces = Backtraces { getBacktrace :: forall a. BacktraceMechanism a -> Maybe a }
+
+displayBacktraces :: Backtraces -> String
+displayBacktraces (Backtraces f) = concat
+ [ displayOne "Cost-centre stack backtrace" CostCentreBacktrace displayCc
+ , displayOne "Native stack backtrace" ExecutionStackBacktrace displayExec
+ , displayOne "IPE backtrace" IPEBacktrace displayIpe
+ , displayOne "HasCallStack backtrace" HasCallStackBacktrace CallStack.prettyCallStack
+ ]
+ where
+ indent :: Int -> String -> String
+ indent n s = replicate n ' ' ++ s
+
+ displayCc = intercalate "\n" . map (indent 4)
+ displayExec = id
+ displayIpe = intercalate "\n" . map (indent 4 . CloneStack.prettyStackEntry)
+
+ displayOne :: String -> BacktraceMechanism rep -> (rep -> String) -> String
+ displayOne label mech displ
+ | Just bt <- f mech = label ++ ":\n" ++ displ bt
+ | otherwise = ""
+
+instance ExceptionAnnotation Backtraces where
+ displayExceptionAnnotation = displayBacktraces
+
+collectBacktraces :: (?callStack :: CallStack) => IO Backtraces
+collectBacktraces = CallStack.withFrozenCallStack $ do
+ EnabledBacktraceMechanisms enabled <- getEnabledBacktraceMechanisms
+ let collect :: BacktraceMechanism a -> IO (Maybe a)
+ collect mech
+ | enabled mech = collectBacktrace mech
+ | otherwise = return Nothing
+
+ ccs <- collect CostCentreBacktrace
+ exec <- collect ExecutionStackBacktrace
+ ipe <- collect IPEBacktrace
+ hcs <- collect HasCallStackBacktrace
+ let f :: BacktraceMechanism rep -> Maybe rep
+ f CostCentreBacktrace = ccs
+ f ExecutionStackBacktrace = exec
+ f IPEBacktrace = ipe
+ f HasCallStackBacktrace = hcs
+ return (Backtraces f)
+
+collectBacktrace :: (?callStack :: CallStack) => BacktraceMechanism a -> IO (Maybe a)
+collectBacktrace CostCentreBacktrace = do
+ strs <- CCS.currentCallStack
+ case strs of
+ [] -> return Nothing
+ _ -> pure (Just strs)
+
+collectBacktrace ExecutionStackBacktrace = do
+ mst <- ExecStack.showStackTrace
+ case mst of
+ Nothing -> return Nothing
+ Just st -> return (Just st)
+
+collectBacktrace IPEBacktrace = do
+ stack <- CloneStack.cloneMyStack
+ stackEntries <- CloneStack.decode stack
+ return (Just stackEntries)
+
+collectBacktrace HasCallStackBacktrace =
+ return (Just ?callStack)
+
=====================================
libraries/base/GHC/Exception/Backtrace.hs-boot
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RoleAnnotations #-}
+
+module GHC.Exception.Backtrace where
+
+import GHC.Base (IO)
+import GHC.Stack.Types (HasCallStack)
+import GHC.Exception.Context (ExceptionAnnotation)
+
+data Backtraces
+
+instance ExceptionAnnotation Backtraces
+
+-- For GHC.Exception
+collectBacktraces :: HasCallStack => IO Backtraces
=====================================
libraries/base/GHC/Exception/Context.hs
=====================================
@@ -0,0 +1,89 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE GADTs #-}
+{-# 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
+ , addExceptionAnnotation
+ , getExceptionAnnotations
+ , getAllExceptionAnnotations
+ , mergeExceptionContext
+ -- * Exception annotations
+ , SomeExceptionAnnotation(..)
+ , ExceptionAnnotation(..)
+ ) where
+
+import GHC.Base ((++), return, String, Maybe(..), Semigroup(..), Monoid(..))
+import GHC.Show (Show(..))
+import Data.Typeable.Internal (Typeable, typeRep, eqTypeRep)
+import Data.Type.Equality ( (:~~:)(HRefl) )
+
+-- | 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 'mergeExceptionContext'.
+data ExceptionContext = ExceptionContext [SomeExceptionAnnotation]
+
+instance Semigroup ExceptionContext where
+ (<>) = mergeExceptionContext
+
+instance Monoid ExceptionContext where
+ mempty = emptyExceptionContext
+
+-- | An 'ExceptionContext' containing no annotations.
+emptyExceptionContext :: ExceptionContext
+emptyExceptionContext = ExceptionContext []
+
+-- | Construct a singleton 'ExceptionContext' from an 'ExceptionAnnotation'.
+addExceptionAnnotation :: ExceptionAnnotation a => a -> ExceptionContext -> ExceptionContext
+addExceptionAnnotation x (ExceptionContext xs) = ExceptionContext (SomeExceptionAnnotation x : xs)
+
+getExceptionAnnotations :: forall a. ExceptionAnnotation a => ExceptionContext -> [a]
+getExceptionAnnotations (ExceptionContext xs) =
+ [ x
+ | SomeExceptionAnnotation (x :: b) <- xs
+ , Just HRefl <- return (typeRep @a `eqTypeRep` typeRep @b)
+ ]
+
+getAllExceptionAnnotations :: ExceptionContext -> [SomeExceptionAnnotation]
+getAllExceptionAnnotations (ExceptionContext xs) = xs
+
+-- | Merge two 'ExceptionContext's via concatenation
+mergeExceptionContext :: ExceptionContext -> ExceptionContext -> ExceptionContext
+mergeExceptionContext (ExceptionContext a) (ExceptionContext b) = ExceptionContext (a ++ b)
+
+
+data SomeExceptionAnnotation = forall a. ExceptionAnnotation a => SomeExceptionAnnotation a
+
+-- | 'ExceptionAnnotation's are types which can decorate exceptions as
+-- 'ExceptionContext'.
+class (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,7 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_HADDOCK not-home #-}
@@ -20,7 +22,20 @@
module GHC.Exception.Type
( Exception(..) -- Class
- , SomeException(..), ArithException(..)
+ , SomeException(..)
+ , exceptionContext
+ , addExceptionContext
+ , mapExceptionContext
+ , NoBacktrace(..)
+ -- * Exception context
+ , ExceptionContext(..)
+ , emptyExceptionContext
+ , mergeExceptionContext
+ , ExceptionWithContext(..)
+ -- * 'WhileHandling' annotations
+ , WhileHandling(..)
+ -- * Arithmetic exceptions
+ , ArithException(..)
, divZeroException, overflowException, ratioZeroDenomException
, underflowException
) where
@@ -30,13 +45,28 @@ 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, ?exceptionContext :: ExceptionContext) => SomeException e
+
+-- | View the 'ExceptionContext' of a 'SomeException'.
+exceptionContext :: SomeException -> ExceptionContext
+exceptionContext (SomeException _) = ?exceptionContext
+
+-- | Add more 'ExceptionContext' to a 'SomeException'.
+addExceptionContext :: ExceptionAnnotation a => a -> SomeException -> SomeException
+addExceptionContext ann =
+ mapExceptionContext (addExceptionAnnotation ann)
+
+mapExceptionContext :: (ExceptionContext -> ExceptionContext) -> SomeException -> SomeException
+mapExceptionContext f se@(SomeException e) =
+ let ?exceptionContext = f (exceptionContext se)
+ in SomeException e
-- | @since 3.0
instance Show SomeException where
@@ -129,10 +159,12 @@ Caught MismatchedParentheses
-}
class (Typeable e, Show e) => Exception e where
+ -- | @toException@ should produce a 'SomeException' with no attached 'ExceptionContext'.
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
- toException = SomeException
+ toException e = SomeException e
+ where ?exceptionContext = emptyExceptionContext
fromException (SomeException e) = cast e
-- | Render this exception value in a human-friendly manner.
@@ -143,14 +175,63 @@ class (Typeable e, Show e) => Exception e where
displayException :: e -> String
displayException = show
+ backtraceDesired :: e -> Bool
+ backtraceDesired _ = True
+
-- | @since 4.8.0.0
instance Exception Void
-- | @since 3.0
instance Exception SomeException where
- toException se = se
+ toException (SomeException e) =
+ let ?exceptionContext = emptyExceptionContext
+ in SomeException e
fromException = Just
- displayException (SomeException e) = displayException e
+ backtraceDesired (SomeException e) = backtraceDesired e
+ displayException (SomeException e) =
+ displayException e ++ "\n" ++ displayContext ?exceptionContext
+
+displayContext :: ExceptionContext -> String
+displayContext (ExceptionContext anns0) = go anns0
+ where
+ go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns
+ go [] = "\n"
+
+newtype NoBacktrace e = NoBacktrace e
+ deriving (Show)
+
+instance Exception e => Exception (NoBacktrace e) where
+ fromException = fmap NoBacktrace . fromException
+ toException (NoBacktrace e) = toException e
+ backtraceDesired _ = False
+
+-- | 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
+
+instance Show a => Show (ExceptionWithContext a) where
+ showsPrec _ (ExceptionWithContext _ e) = showString "ExceptionWithContext _ " . shows e
+
+instance Exception a => Exception (ExceptionWithContext a) where
+ toException (ExceptionWithContext ctxt e) =
+ SomeException e
+ where ?exceptionContext = ctxt
+ fromException se = do
+ e <- fromException se
+ return (ExceptionWithContext (exceptionContext se) e)
+ backtraceDesired (ExceptionWithContext _ e) = backtraceDesired e
+ displayException = displayException . toException
+
+-- | An 'ExceptionAnnotation' applied by 'catch' and similar operations
+-- to exceptions thrown while handling another exception.
+--
+-- @since 4.19.0.0
+newtype WhileHandling = WhileHandling SomeException
+
+instance ExceptionAnnotation WhileHandling where
+ displayExceptionAnnotation (WhileHandling e) =
+ "While handling: " ++ displayException e
-- |Arithmetic exceptions.
data ArithException
=====================================
libraries/base/GHC/IO.hs
=====================================
@@ -28,6 +28,7 @@ module GHC.IO (
unsafePerformIO, unsafeInterleaveIO,
unsafeDupablePerformIO, unsafeDupableInterleaveIO,
noDuplicate,
+ annotateIO,
-- To and from ST
stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
@@ -47,8 +48,10 @@ import GHC.ST
import GHC.Exception
import GHC.Show
import GHC.IO.Unsafe
+import GHC.Stack.Types ( HasCallStack )
import Unsafe.Coerce ( unsafeCoerce )
+import GHC.Exception.Context ( ExceptionAnnotation )
import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
-- ---------------------------------------------------------------------------
@@ -158,6 +161,10 @@ catchException !io handler = catch io handler
-- to catch exceptions of any type, see the section \"Catching all
-- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
--
+-- If the exception handler throws an exception during execution, the
+-- thrown exception will be annotated with a 'WhileHandling'
+-- 'ExceptionAnnotation'.
+--
-- For catching exceptions in pure (non-'IO') expressions, see the
-- function 'evaluate'.
--
@@ -182,10 +189,29 @@ catch :: Exception e
-> IO a
-- See #exceptions_and_strictness#.
catch (IO io) handler = IO $ catch# io handler'
- where handler' e = case fromException e of
- Just e' -> unIO (handler e')
- Nothing -> raiseIO# e
-
+ where
+ handler' e =
+ case fromException e of
+ Just e' -> unIO (withWhileHandling e (handler e'))
+ Nothing -> raiseIO# e
+
+-- | Catch an exception without adding a 'CausedBy' 'ExceptionContext' to any
+-- exceptions thrown by the handler. See the documentation of 'catch' for a
+-- detailed description of the semantics of this function.
+--
+-- @since 4.19.0.0
+catchNoCause
+ :: Exception e
+ => IO a -- ^ The computation to run
+ -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
+ -> IO a
+-- See #exceptions_and_strictness#.
+catchNoCause (IO io) handler = IO $ catch# io handler'
+ where
+ handler' e =
+ case fromException e of
+ Just e' -> unIO (handler e')
+ Nothing -> raiseIO# e
-- | Catch any 'Exception' type in the 'IO' monad.
--
@@ -194,7 +220,19 @@ catch (IO io) handler = IO $ catch# io handler'
-- details.
catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny !(IO io) handler = IO $ catch# io handler'
- where handler' (SomeException e) = unIO (handler e)
+ where
+ handler' se@(SomeException e) =
+ unIO (withWhileHandling se (handler e))
+
+withWhileHandling :: SomeException -> IO a -> IO a
+withWhileHandling cause = annotateIO (WhileHandling cause)
+
+-- | Execute an 'IO' action, adding the given 'ExceptionContext'
+-- to any thrown synchronous exceptions.
+annotateIO :: forall e a. ExceptionAnnotation e => e -> IO a -> IO a
+annotateIO ann (IO io) = IO (catch# io handler)
+ where
+ handler se = raiseIO# (addExceptionContext ann se)
-- Using catchException here means that if `m` throws an
-- 'IOError' /as an imprecise exception/, we will not catch
@@ -235,8 +273,10 @@ 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
+ se <- toExceptionWithBacktrace e
+ IO (raiseIO# se)
-- -----------------------------------------------------------------------------
-- Controlling asynchronous exception delivery
@@ -310,8 +350,9 @@ getMaskingState = IO $ \s ->
_ -> MaskedInterruptible #)
onException :: IO a -> IO b -> IO a
-onException io what = io `catchException` \e -> do _ <- what
- throwIO (e :: SomeException)
+onException io what = io `catchException` \e -> do
+ _ <- what
+ throwIO $ NoBacktrace (e :: SomeException)
-- | Executes an IO computation with asynchronous
-- exceptions /masked/. That is, any thread which attempts to raise
=====================================
libraries/base/GHC/IO/Exception.hs
=====================================
@@ -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 )
@@ -184,18 +185,17 @@ 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.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.
@@ -306,11 +306,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/base.cabal
=====================================
@@ -209,6 +209,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
=====================================
@@ -1,6 +1,7 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.19.0.0 *TBA*
+
* Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110))
* `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable
types significantly.
@@ -12,6 +13,11 @@
* Add `Type.Reflection.decTypeRep`, `Data.Typeable.decT` and `Data.Typeable.hdecT` equality decisions functions.
([CLC proposal #98](https://github.com/haskell/core-libraries-committee/issues/98))
* Add `Data.Functor.unzip` ([CLC proposal #88](https://github.com/haskell/core-libraries-committee/issues/88))
+ * 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`.
## 4.18.0.0 *TBA*
=====================================
libraries/base/tests/IO/T21336/T21336a.stderr
=====================================
@@ -1 +1,14 @@
-Exception during weak pointer finalization (ignored): GHC.IO.FD.fdWrite: resource exhausted (No space left on device)
+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,9 @@
-Exception during weak pointer finalization (ignored): <stdout>: hFlush: resource exhausted (No space left on device)
+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
+
=====================================
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/f73f33097195b87fd05ae95b829c639f953548af...2d9ea503c8d71d14325ce4e0b590d8dc136f5b10
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f73f33097195b87fd05ae95b829c639f953548af...2d9ea503c8d71d14325ce4e0b590d8dc136f5b10
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/20230510/eb945231/attachment-0001.html>
More information about the ghc-commits
mailing list