[Git][ghc/ghc][master] Add HasCallStack to Control.Monad.Fail.fail
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1e9eb118 by Andrew Lelechenko at 2025-06-12T03:48:21-04:00 Add HasCallStack to Control.Monad.Fail.fail CLC proposal https://github.com/haskell/core-libraries-committee/issues/327 2% compile-time allocations increase in T3064, likely because `fail` is now marginally more expensive to compile. Metric Increase: T3064 - - - - - 18 changed files: - libraries/base/changelog.md - libraries/base/tests/IO/withBinaryFile002.stderr - libraries/base/tests/IO/withFile002.stderr - libraries/base/tests/IO/withFileBlocking002.stderr - libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs - libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs-boot - libraries/ghc-internal/src/GHC/Internal/IO.hs-boot - libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot - testsuite/tests/deSugar/should_run/DsDoExprFailMsg.stderr - testsuite/tests/deSugar/should_run/DsMonadCompFailMsg.stderr - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/th/T15321.stderr - testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - utils/haddock/hypsrc-test/ref/src/Quasiquoter.html Changes: ===================================== libraries/base/changelog.md ===================================== @@ -9,6 +9,7 @@ * `Data.List.NonEmpty.{init,last,tails1}` are now defined using only total functions (rather than partial ones). ([CLC proposal #293](https://github.com/haskell/core-libraries-committee/issues/293)) * `Data.List.NonEmpty` functions now have the same laziness as their `Data.List` counterparts (i.e. make them more strict than they currently are) ([CLC proposal #107](https://github.com/haskell/core-libraries-committee/issues/107)) * `instance Functor NonEmpty` is now specified using `map` (rather than duplicating code). ([CLC proposal #300](https://github.com/haskell/core-libraries-committee/issues/300)) + * `fail` from `MonadFail` now carries `HasCallStack` constraint. ([CLC proposal #327](https://github.com/haskell/core-libraries-committee/issues/327)) * The `Data.Enum.enumerate` function was introduced ([CLC #306](https://github.com/haskell/core-libraries-committee/issues/306)) * Worker threads used by various `base` facilities are now labelled with descriptive thread labels ([CLC proposal #305](https://github.com/haskell/core-libraries-committee/issues/305), [GHC #25452](https://gitlab.haskell.org/ghc/ghc/-/issues/25452)). Specifically, these include: * `Control.Concurrent.threadWaitRead` ===================================== libraries/base/tests/IO/withBinaryFile002.stderr ===================================== @@ -1,3 +1,9 @@ withBinaryFile002: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException: user error (test) + +HasCallStack backtrace: + throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:66:12 in ghc-internal:GHC.Internal.Control.Monad.Fail + a type signature in an instance, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:65:13 in ghc-internal:GHC.Internal.Control.Monad.Fail + fail, called at withBinaryFile002.hs:8:5 in main:Main + ===================================== libraries/base/tests/IO/withFile002.stderr ===================================== @@ -1,3 +1,9 @@ withFile002: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException: user error (test) + +HasCallStack backtrace: + throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:66:12 in ghc-internal:GHC.Internal.Control.Monad.Fail + a type signature in an instance, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:65:13 in ghc-internal:GHC.Internal.Control.Monad.Fail + fail, called at withFile002.hs:8:5 in main:Main + ===================================== libraries/base/tests/IO/withFileBlocking002.stderr ===================================== @@ -1,3 +1,9 @@ withFileBlocking002: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException: user error (test) + +HasCallStack backtrace: + throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:66:12 in ghc-internal:GHC.Internal.Control.Monad.Fail + a type signature in an instance, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:65:13 in ghc-internal:GHC.Internal.Control.Monad.Fail + fail, called at withFileBlocking002.hs:9:5 in main:Main + ===================================== libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -13,7 +14,10 @@ -- module GHC.Internal.Control.Monad.Fail ( MonadFail(fail) ) where -import GHC.Internal.Base (String, Monad(), Maybe(Nothing), IO(), failIO) +import GHC.Internal.Base (String, Monad(), Maybe(Nothing), IO(), (.)) +import {-# SOURCE #-} GHC.Internal.IO (throwIO) +import {-# SOURCE #-} GHC.Internal.IO.Exception (userError) +import GHC.Internal.Stack.Types (HasCallStack) -- | When a value is bound in @do@-notation, the pattern on the left -- hand side of @<-@ might not match. In this case, this class @@ -42,18 +46,21 @@ import GHC.Internal.Base (String, Monad(), Maybe(Nothing), IO(), failIO) -- -- @since base-4.9.0.0 class Monad m => MonadFail m where - fail :: String -> m a + fail :: HasCallStack => String -> m a -- | @since base-4.9.0.0 instance MonadFail Maybe where + fail :: HasCallStack => String -> Maybe a fail _ = Nothing -- | @since base-4.9.0.0 instance MonadFail [] where {-# INLINE fail #-} + fail :: HasCallStack => String -> [a] fail _ = [] -- | @since base-4.9.0.0 instance MonadFail IO where - fail = failIO + fail :: HasCallStack => String -> IO a + fail = throwIO . userError ===================================== libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs-boot ===================================== @@ -2,7 +2,8 @@ {-# LANGUAGE NoImplicitPrelude #-} module GHC.Internal.Exception.Type - ( SomeException + ( Exception + , SomeException , divZeroException , overflowException , ratioZeroDenomException @@ -12,6 +13,8 @@ module GHC.Internal.Exception.Type -- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base import GHC.Internal.Types () +class Exception e + data SomeException divZeroException, overflowException, ratioZeroDenomException, underflowException :: SomeException ===================================== libraries/ghc-internal/src/GHC/Internal/IO.hs-boot ===================================== @@ -3,8 +3,10 @@ module GHC.Internal.IO where +import GHC.Internal.Stack.Types (HasCallStack) import GHC.Internal.Types -import {-# SOURCE #-} GHC.Internal.Exception.Type (SomeException) +import {-# SOURCE #-} GHC.Internal.Exception.Type (Exception, SomeException) mplusIO :: IO a -> IO a -> IO a mkUserError :: [Char] -> SomeException +throwIO :: (HasCallStack, Exception e) => e -> IO a ===================================== libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs-boot ===================================== @@ -4,7 +4,7 @@ module GHC.Internal.IO.Exception where import GHC.Internal.Base -import GHC.Internal.Exception +import {-# SOURCE #-} GHC.Internal.Exception.Type data IOException instance Exception IOException ===================================== testsuite/tests/deSugar/should_run/DsDoExprFailMsg.stderr ===================================== @@ -1,3 +1,9 @@ DsDoExprFailMsg: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException: user error (Pattern match failure in 'do' block at DsDoExprFailMsg.hs:2:3-8) + +HasCallStack backtrace: + throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:66:12 in ghc-internal:GHC.Internal.Control.Monad.Fail + a type signature in an instance, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:65:13 in ghc-internal:GHC.Internal.Control.Monad.Fail + a do statement, called at DsDoExprFailMsg.hs:2:3 in main:Main + ===================================== testsuite/tests/deSugar/should_run/DsMonadCompFailMsg.stderr ===================================== @@ -1,3 +1,9 @@ DsMonadCompFailMsg: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException: user error (Pattern match failure in monad comprehension at DsMonadCompFailMsg.hs:2:14-19) + +HasCallStack backtrace: + throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:66:12 in ghc-internal:GHC.Internal.Control.Monad.Fail + a type signature in an instance, called at libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs:65:13 in ghc-internal:GHC.Internal.Control.Monad.Fail + a monad comprehension pattern, called at DsMonadCompFailMsg.hs:2:14 in main:Main + ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== @@ -452,7 +452,7 @@ module Control.Monad where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} type MonadPlus :: (* -> *) -> Constraint class (GHC.Internal.Base.Alternative m, Monad m) => MonadPlus m where @@ -492,7 +492,7 @@ module Control.Monad.Fail where -- Safety: Safe type MonadFail :: (* -> *) -> Constraint class GHC.Internal.Base.Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} module Control.Monad.Fix where @@ -9991,7 +9991,7 @@ module Prelude where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => String -> m a {-# MINIMAL fail #-} type Monoid :: * -> Constraint class Semigroup a => Monoid a where ===================================== testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs ===================================== @@ -452,7 +452,7 @@ module Control.Monad where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} type MonadPlus :: (* -> *) -> Constraint class (GHC.Internal.Base.Alternative m, Monad m) => MonadPlus m where @@ -492,7 +492,7 @@ module Control.Monad.Fail where -- Safety: Safe type MonadFail :: (* -> *) -> Constraint class GHC.Internal.Base.Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} module Control.Monad.Fix where @@ -13037,7 +13037,7 @@ module Prelude where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => String -> m a {-# MINIMAL fail #-} type Monoid :: * -> Constraint class Semigroup a => Monoid a where ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== @@ -452,7 +452,7 @@ module Control.Monad where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} type MonadPlus :: (* -> *) -> Constraint class (GHC.Internal.Base.Alternative m, Monad m) => MonadPlus m where @@ -492,7 +492,7 @@ module Control.Monad.Fail where -- Safety: Safe type MonadFail :: (* -> *) -> Constraint class GHC.Internal.Base.Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} module Control.Monad.Fix where @@ -10271,7 +10271,7 @@ module Prelude where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => String -> m a {-# MINIMAL fail #-} type Monoid :: * -> Constraint class Semigroup a => Monoid a where ===================================== testsuite/tests/interface-stability/base-exports.stdout-ws-32 ===================================== @@ -452,7 +452,7 @@ module Control.Monad where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} type MonadPlus :: (* -> *) -> Constraint class (GHC.Internal.Base.Alternative m, Monad m) => MonadPlus m where @@ -492,7 +492,7 @@ module Control.Monad.Fail where -- Safety: Safe type MonadFail :: (* -> *) -> Constraint class GHC.Internal.Base.Monad m => MonadFail m where - fail :: forall a. GHC.Internal.Base.String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => GHC.Internal.Base.String -> m a {-# MINIMAL fail #-} module Control.Monad.Fix where @@ -9991,7 +9991,7 @@ module Prelude where {-# MINIMAL (>>=) #-} type MonadFail :: (* -> *) -> Constraint class Monad m => MonadFail m where - fail :: forall a. String -> m a + fail :: forall a. GHC.Internal.Stack.Types.HasCallStack => String -> m a {-# MINIMAL fail #-} type Monoid :: * -> Constraint class Semigroup a => Monoid a where ===================================== testsuite/tests/th/T15321.stderr ===================================== @@ -3,7 +3,9 @@ T15321.hs:9:9: error: [GHC-88464] • In the expression: _ "baz" In the untyped splice: $(_ "baz") • Valid hole fits include - fail :: forall (m :: * -> *) a. MonadFail m => String -> m a + fail :: forall (m :: * -> *) a. + (MonadFail m, GHC.Internal.Stack.Types.HasCallStack) => + String -> m a with fail @GHC.Internal.TH.Syntax.Q @GHC.Internal.TH.Syntax.Exp (imported from ‘Prelude’ at T15321.hs:3:8-13 (and originally defined in ‘GHC.Internal.Control.Monad.Fail’)) ===================================== testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr ===================================== @@ -1,4 +1,3 @@ - subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: String -> [String] • In the expression: _ "hello, world" @@ -24,7 +23,9 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef with mempty @(String -> [String]) (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 (and originally defined in ‘GHC.Internal.Base’)) - fail :: forall (m :: * -> *) a. MonadFail m => String -> m a + fail :: forall (m :: * -> *) a. + (MonadFail m, GHC.Internal.Stack.Types.HasCallStack) => + String -> m a with fail @[] @String (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 (and originally defined in ‘GHC.Internal.Control.Monad.Fail’)) @@ -36,3 +37,4 @@ subsumption_sort_hole_fits.hs:2:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdef with pure @[] @String (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 (and originally defined in ‘GHC.Internal.Base’)) + ===================================== testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr ===================================== @@ -247,7 +247,9 @@ valid_hole_fits.hs:41:8: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] with print @String (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 (and originally defined in ‘GHC.Internal.System.IO’)) - fail :: forall (m :: * -> *) a. MonadFail m => String -> m a + fail :: forall (m :: * -> *) a. + (MonadFail m, GHC.Internal.Stack.Types.HasCallStack) => + String -> m a with fail @IO @() (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 (and originally defined in ‘GHC.Internal.Control.Monad.Fail’)) ===================================== utils/haddock/hypsrc-test/ref/src/Quasiquoter.html ===================================== @@ -405,8 +405,10 @@ forall a. String -> Q a ><span class="annot" ><span class="annottext" >String -> Q a -forall a. String -> Q a -forall (m :: * -> *) a. MonadFail m => String -> m a +forall a. HasCallStack => String -> Q a +forall (m :: * -> *) a. +(MonadFail m, HasCallStack) => +String -> m a </span ><span class="hs-identifier hs-var" >failhttps://gitlab.haskell.org/ghc/ghc/-/commit/1e9eb11894f180fd9c3d9438ec025d37... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e9eb11894f180fd9c3d9438ec025d37... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Marge Bot (＠marge-bot)