[Git][ghc/ghc][master] Replace '?callStack' implicit param with HasCallStack in GHC.Internal.Exception.throw
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Jun 8 15:24:24 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
edfe6140 by qqwy at 2024-06-08T11:23:54-04:00
Replace '?callStack' implicit param with HasCallStack in GHC.Internal.Exception.throw
- - - - -
5 changed files:
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- 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
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception.hs
=====================================
@@ -79,7 +79,7 @@ import GHC.Internal.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.
- (?callStack :: CallStack, Exception e) => e -> a
+ (HasCallStack, Exception e) => e -> a
throw e =
let !se = unsafePerformIO (toExceptionWithBacktrace e)
in raise# se
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -292,7 +292,7 @@ module Control.Exception where
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -407,7 +407,7 @@ module Control.Exception.Base where
patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -5319,7 +5319,7 @@ module GHC.Exception where
prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
ratioZeroDenomException :: SomeException
showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
underflowException :: SomeException
module GHC.Exception.Type where
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -292,7 +292,7 @@ module Control.Exception where
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -407,7 +407,7 @@ module Control.Exception.Base where
patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -5288,7 +5288,7 @@ module GHC.Exception where
prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
ratioZeroDenomException :: SomeException
showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
underflowException :: SomeException
module GHC.Exception.Type where
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -292,7 +292,7 @@ module Control.Exception where
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -407,7 +407,7 @@ module Control.Exception.Base where
patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -5465,7 +5465,7 @@ module GHC.Exception where
prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
ratioZeroDenomException :: SomeException
showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
underflowException :: SomeException
module GHC.Exception.Type where
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -292,7 +292,7 @@ module Control.Exception where
mask_ :: forall a. GHC.Types.IO a -> GHC.Types.IO a
onException :: forall a b. GHC.Types.IO a -> GHC.Types.IO b -> GHC.Types.IO a
someExceptionContext :: SomeException -> GHC.Internal.Exception.Context.ExceptionContext
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -407,7 +407,7 @@ module Control.Exception.Base where
patError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recConError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
recSelError :: forall (q :: GHC.Types.RuntimeRep) (a :: TYPE q). GHC.Prim.Addr# -> a
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::GHC.Internal.Stack.Types.CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
throwIO :: forall e a. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> GHC.Types.IO a
throwTo :: forall e. Exception e => GHC.Internal.Conc.Sync.ThreadId -> e -> GHC.Types.IO ()
try :: forall e a. Exception e => GHC.Types.IO a -> GHC.Types.IO (GHC.Internal.Data.Either.Either e a)
@@ -5319,7 +5319,7 @@ module GHC.Exception where
prettySrcLoc :: SrcLoc -> GHC.Internal.Base.String
ratioZeroDenomException :: SomeException
showCCSStack :: [GHC.Internal.Base.String] -> [GHC.Internal.Base.String]
- throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (?callStack::CallStack, Exception e) => e -> a
+ throw :: forall (r :: GHC.Types.RuntimeRep) (a :: TYPE r) e. (GHC.Internal.Stack.Types.HasCallStack, Exception e) => e -> a
underflowException :: SomeException
module GHC.Exception.Type where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edfe6140be64f0d9365f7e954d3db534d63bb04f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/edfe6140be64f0d9365f7e954d3db534d63bb04f
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/20240608/9f77ba7d/attachment-0001.html>
More information about the ghc-commits
mailing list