diff --git a/libraries/ghc-internal/src/GHC/Internal/Exception.hs b/libraries/ghc-internal/src/GHC/Internal/Exception.hs
index 1aabfb1e56accbfc25a8dd99a2e816fe4b2783f8..50005ba363ce2da08b0a5045784369dfed61470d 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Exception.hs
+++ b/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
diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout
index 0e8f2cb9c1c6751434858453375502ac3afdc59e..9090e52a4ee18aa0271aedbedb57702d8a810033 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout
+++ b/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
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
index 9a365415902e1ba64b3f0a82761391604312957a..0c497e3208596e08d8f1e6024a843efaa7209a2b 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
+++ b/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
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
index 3ee181fb052ad5d5bc8828f36b3d95ab9b264157..b9c98c9f3325280d7ee5a65f17d937b187216f5a 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32
+++ b/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
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
index 0e8f2cb9c1c6751434858453375502ac3afdc59e..9090e52a4ee18aa0271aedbedb57702d8a810033 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32
+++ b/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