[Git][ghc/ghc][wip/romes/restore-ecwl] Re-introduce ErrorCallWithLocation with a deprecation pragma
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri Nov 22 11:15:46 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/restore-ecwl at Glasgow Haskell Compiler / GHC
Commits:
63edd2cd by Rodrigo Mesquita at 2024-11-22T11:15:32+00:00
Re-introduce ErrorCallWithLocation with a deprecation pragma
With the removal of the duplicate backtrace, part of CLC proposal #285,
the constructor `ErrorCallWithLocation` was removed from base.
This commit re-introduces it with a deprecation.
- - - - -
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
=====================================
@@ -8,6 +8,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
@@ -52,7 +53,7 @@ module GHC.Internal.Exception
, ratioZeroDenomException
, underflowException
-- ** 'ErrorCall'
- , ErrorCall(..)
+ , ErrorCall(.., ErrorCallWithLocation)
, errorCallException
, errorCallWithCallStackException
, toExceptionWithBacktrace
@@ -178,7 +179,11 @@ data ErrorCall = ErrorCall String
, Ord -- ^ @since base-4.7.0.0
)
-{-# COMPLETE ErrorCall #-}
+{-# DEPRECATED ErrorCallWithLocation "ErrorCallWithLocation has been deprecated in favour of ErrorCall (which does not have a location). Backtraces are now handled by the backtrace exception mechanisms exclusively." #-}
+pattern ErrorCallWithLocation :: String -> String -> ErrorCall
+pattern ErrorCallWithLocation err loc <- ErrorCall ((\err -> (err, error "ErrorCallWithLocation has been deprecated in favour of ErrorCall (which does not have a location). Backtraces are now handled by the backtrace exception mechanisms exclusively.")) -> (err, loc))
+ where ErrorCallWithLocation err _ = ErrorCall err
+{-# COMPLETE ErrorCallWithLocation #-}
-- | @since base-4.0.0.0
instance Exception ErrorCall
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -232,6 +232,7 @@ module Control.Exception where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -349,6 +350,7 @@ module Control.Exception.Base where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -5305,6 +5307,7 @@ module GHC.Exception where
data CallStack = ...
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -232,6 +232,7 @@ module Control.Exception where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -349,6 +350,7 @@ module Control.Exception.Base where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -5274,6 +5276,7 @@ module GHC.Exception where
data CallStack = ...
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -232,6 +232,7 @@ module Control.Exception where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -349,6 +350,7 @@ module Control.Exception.Base where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -5451,6 +5453,7 @@ module GHC.Exception where
data CallStack = ...
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -232,6 +232,7 @@ module Control.Exception where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -349,6 +350,7 @@ module Control.Exception.Base where
data Deadlock = Deadlock
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
@@ -5305,6 +5307,7 @@ module GHC.Exception where
data CallStack = ...
type ErrorCall :: *
data ErrorCall = ErrorCall GHC.Internal.Base.String
+ pattern ErrorCallWithLocation :: GHC.Internal.Base.String -> GHC.Internal.Base.String -> ErrorCall
type Exception :: * -> Constraint
class (ghc-internal-9.1100.0:GHC.Internal.Data.Typeable.Internal.Typeable e, GHC.Internal.Show.Show e) => Exception e where
toException :: e -> SomeException
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63edd2cdb6eee16e667f0413f2bd6b191e668bef
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/63edd2cdb6eee16e667f0413f2bd6b191e668bef
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/20241122/27bc598b/attachment-0001.html>
More information about the ghc-commits
mailing list