Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly)

15 files changed, 65 insertions, 133 deletions

diff --git a/compiler/GHC/Data/IOEnv.hs b/compiler/GHC/Data/IOEnv.hs
index 86f16b229b..5478af0eee 100644
--- a/compiler/GHC/Data/IOEnv.hs
+++ b/compiler/GHC/Data/IOEnv.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingVia #-}
 --
 -- (c) The University of Glasgow 2002-2006
 --
@@ -43,6 +44,8 @@ import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,
 import System.IO.Unsafe ( unsafeInterleaveIO )
 import System.IO        ( fixIO )
 import Control.Monad
+import Control.Monad.Trans.Reader
+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import GHC.Utils.Monad
 import Control.Applicative (Alternative(..))
 
@@ -51,7 +54,9 @@ import Control.Applicative (Alternative(..))
 ----------------------------------------------------------------------
 
 
-newtype IOEnv env a = IOEnv (env -> IO a) deriving (Functor)
+newtype IOEnv env a = IOEnv (env -> IO a)
+  deriving (Functor)
+  deriving (MonadThrow, MonadCatch, MonadMask, MonadIO) via (ReaderT env IO)
 
 unIOEnv :: IOEnv env a -> (env -> IO a)
 unIOEnv (IOEnv m) = m
@@ -91,16 +96,6 @@ instance Show IOEnvFailure where
 
 instance Exception IOEnvFailure
 
-instance ExceptionMonad (IOEnv a) where
-  gcatch act handle =
-      IOEnv $ \s -> unIOEnv act s `gcatch` \e -> unIOEnv (handle e) s
-  gmask f =
-      IOEnv $ \s -> gmask $ \io_restore ->
-                             let
-                                g_restore (IOEnv m) = IOEnv $ \s -> io_restore (m s)
-                             in
-                                unIOEnv (f g_restore) s
-
 instance ContainsDynFlags env => HasDynFlags (IOEnv env) where
     getDynFlags = do env <- getEnv
                      return $! extractDynFlags env
@@ -176,9 +171,6 @@ instance MonadPlus (IOEnv env)
 -- Accessing input/output
 ----------------------------------------------------------------------
 
-instance MonadIO (IOEnv env) where
-    liftIO io = IOEnv (\ _ -> io)
-
 newMutVar :: a -> IOEnv env (IORef a)
 newMutVar val = liftIO (newIORef val)
 
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index b76874eeab..43c988c4c2 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -53,7 +53,7 @@ import GHC.Driver.Main
 import GHC.Data.Bag        ( unitBag, listToBag, unionManyBags, isEmptyBag )
 import GHC.Types.Basic
 import GHC.Data.Graph.Directed
-import GHC.Utils.Exception ( tryIO, gbracket, gfinally )
+import GHC.Utils.Exception ( tryIO )
 import GHC.Data.FastString
 import GHC.Data.Maybe      ( expectJust )
 import GHC.Types.Name
@@ -85,6 +85,7 @@ import Control.Concurrent.QSem
 import Control.Exception
 import Control.Monad
 import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )
+import qualified Control.Monad.Catch as MC
 import Data.IORef
 import Data.List
 import qualified Data.List as List
@@ -994,10 +995,10 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
     -- Reset the number of capabilities once the upsweep ends.
     let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n
 
-    gbracket updNumCapabilities resetNumCapabilities $ \_ -> do
+    MC.bracket updNumCapabilities resetNumCapabilities $ \_ -> do
 
     -- Sync the global session with the latest HscEnv once the upsweep ends.
-    let finallySyncSession io = io `gfinally` do
+    let finallySyncSession io = io `MC.finally` do
             hsc_env <- liftIO $ readMVar hsc_env_var
             setSession hsc_env
 
@@ -1061,7 +1062,7 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
 
                 -- Unmask asynchronous exceptions and perform the thread-local
                 -- work to compile the module (see parUpsweep_one).
-                m_res <- try $ unmask $ prettyPrintGhcErrors lcl_dflags $
+                m_res <- MC.try $ unmask $ prettyPrintGhcErrors lcl_dflags $
                         parUpsweep_one mod home_mod_map comp_graph_loops
                                        lcl_dflags mHscMessage cleanup
                                        par_sem hsc_env_var old_hpt_var
@@ -1097,12 +1098,12 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
 
         -- Kill all the workers, masking interrupts (since killThread is
         -- interruptible). XXX: This is not ideal.
-        ; killWorkers = uninterruptibleMask_ . mapM_ killThread }
+        ; killWorkers = MC.uninterruptibleMask_ . mapM_ killThread }
 
 
     -- Spawn the workers, making sure to kill them later. Collect the results
     -- of each compile.
-    results <- liftIO $ bracket spawnWorkers killWorkers $ \_ ->
+    results <- liftIO $ MC.bracket spawnWorkers killWorkers $ \_ ->
         -- Loop over each module in the compilation graph in order, printing
         -- each message from its log_queue.
         forM comp_graph $ \(mod,mvar,log_queue) -> do
@@ -1278,7 +1279,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
         let logger err = printBagOfErrors lcl_dflags (srcErrorMessages err)
 
         -- Limit the number of parallel compiles.
-        let withSem sem = bracket_ (waitQSem sem) (signalQSem sem)
+        let withSem sem = MC.bracket_ (waitQSem sem) (signalQSem sem)
         mb_mod_info <- withSem par_sem $
             handleSourceError (\err -> do logger err; return Nothing) $ do
                 -- Have the ModSummary and HscEnv point to our local log_action
@@ -2671,7 +2672,7 @@ withDeferredDiagnostics f = do
         setLogAction action = modifySession $ \hsc_env ->
           hsc_env{ hsc_dflags = (hsc_dflags hsc_env){ log_action = action } }
 
-    gbracket
+    MC.bracket
       (setLogAction deferDiagnostics)
       (\_ -> setLogAction (log_action dflags) >> printDeferredDiagnostics)
       (\_ -> f)
diff --git a/compiler/GHC/Driver/Monad.hs b/compiler/GHC/Driver/Monad.hs
index d0c950baf5..72dc3b9800 100644
--- a/compiler/GHC/Driver/Monad.hs
+++ b/compiler/GHC/Driver/Monad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, DeriveFunctor, RankNTypes #-}
+{-# LANGUAGE CPP, DeriveFunctor, DerivingVia, RankNTypes #-}
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 -- -----------------------------------------------------------------------------
 --
@@ -32,6 +32,8 @@ import GHC.Utils.Exception
 import GHC.Utils.Error
 
 import Control.Monad
+import Control.Monad.Catch as MC
+import Control.Monad.Trans.Reader
 import Data.IORef
 
 -- -----------------------------------------------------------------------------
@@ -50,7 +52,7 @@ import Data.IORef
 -- If you do not use 'Ghc' or 'GhcT', make sure to call 'GHC.initGhcMonad'
 -- before any call to the GHC API functions can occur.
 --
-class (Functor m, MonadIO m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where
+class (Functor m, ExceptionMonad m, HasDynFlags m) => GhcMonad m where
   getSession :: m HscEnv
   setSession :: HscEnv -> m ()
 
@@ -71,7 +73,7 @@ modifySession f = do h <- getSession
 withSavedSession :: GhcMonad m => m a -> m a
 withSavedSession m = do
   saved_session <- getSession
-  m `gfinally` setSession saved_session
+  m `MC.finally` setSession saved_session
 
 -- | Call an action with a temporarily modified Session.
 withTempSession :: GhcMonad m => (HscEnv -> HscEnv) -> m a -> m a
@@ -90,7 +92,9 @@ logWarnings warns = do
 -- | A minimal implementation of a 'GhcMonad'.  If you need a custom monad,
 -- e.g., to maintain additional state consider wrapping this monad or using
 -- 'GhcT'.
-newtype Ghc a = Ghc { unGhc :: Session -> IO a } deriving (Functor)
+newtype Ghc a = Ghc { unGhc :: Session -> IO a }
+  deriving (Functor)
+  deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT Session IO)
 
 -- | The Session is a handle to the complete state of a compilation
 -- session.  A compilation session consists of a set of modules
@@ -111,16 +115,6 @@ instance MonadIO Ghc where
 instance MonadFix Ghc where
   mfix f = Ghc $ \s -> mfix (\x -> unGhc (f x) s)
 
-instance ExceptionMonad Ghc where
-  gcatch act handle =
-      Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
-  gmask f =
-      Ghc $ \s -> gmask $ \io_restore ->
-                             let
-                                g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
-                             in
-                                unGhc (f g_restore) s
-
 instance HasDynFlags Ghc where
   getDynFlags = getSessionDynFlags
 
@@ -155,7 +149,8 @@ reifyGhc act = Ghc $ act
 --
 -- Note that the wrapped monad must support IO and handling of exceptions.
 newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
-    deriving (Functor)
+  deriving (Functor)
+  deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT Session m)
 
 liftGhcT :: m a -> GhcT m a
 liftGhcT m = GhcT $ \_ -> m
@@ -170,16 +165,6 @@ instance Monad m => Monad (GhcT m) where
 instance MonadIO m => MonadIO (GhcT m) where
   liftIO ioA = GhcT $ \_ -> liftIO ioA
 
-instance ExceptionMonad m => ExceptionMonad (GhcT m) where
-  gcatch act handle =
-      GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
-  gmask f =
-      GhcT $ \s -> gmask $ \io_restore ->
-                           let
-                              g_restore (GhcT m) = GhcT $ \s -> io_restore (m s)
-                           in
-                              unGhcT (f g_restore) s
-
 instance MonadIO m => HasDynFlags (GhcT m) where
   getDynFlags = GhcT $ \(Session r) -> liftM hsc_dflags (liftIO $ readIORef r)
 
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 5d9583fdb9..9732dd9e4d 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -77,6 +78,7 @@ import System.Directory
 import System.FilePath
 import System.IO
 import Control.Monad
+import qualified Control.Monad.Catch as MC (handle)
 import Data.List        ( isInfixOf, intercalate )
 import Data.Maybe
 import Data.Version
@@ -101,7 +103,7 @@ preprocess :: HscEnv
            -> IO (Either ErrorMessages (DynFlags, FilePath))
 preprocess hsc_env input_fn mb_input_buf mb_phase =
   handleSourceError (\err -> return (Left (srcErrorMessages err))) $
-  ghandle handler $
+  MC.handle handler $
   fmap Right $ do
   MASSERT2(isJust mb_phase || isHaskellSrcFilename input_fn, text input_fn)
   (dflags, fp, mb_iface) <- runPipeline anyHsc hsc_env (input_fn, mb_input_buf, fmap RealPhase mb_phase)
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 12424a48c5..c93dc7649f 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -231,6 +231,7 @@ import System.FilePath
 import Control.DeepSeq
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class
+import Control.Monad.Catch as MC (MonadCatch, catch)
 
 -- -----------------------------------------------------------------------------
 -- Compilation state
@@ -352,12 +353,12 @@ instance Exception SourceError
 
 -- | Perform the given action and call the exception handler if the action
 -- throws a 'SourceError'.  See 'SourceError' for more information.
-handleSourceError :: (ExceptionMonad m) =>
+handleSourceError :: (MonadCatch m) =>
                      (SourceError -> m a) -- ^ exception handler
                   -> m a -- ^ action to perform
                   -> m a
 handleSourceError handler act =
-  gcatch act (\(e :: SourceError) -> handler e)
+  MC.catch act (\(e :: SourceError) -> handler e)
 
 -- | An error thrown if the GHC API is used in an incorrect fashion.
 newtype GhcApiError = GhcApiError String
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index fea2fe666d..68103fc1f4 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -615,14 +615,14 @@ checkModUsage this_pkg UsageHomeModule{
 checkModUsage _this_pkg UsageFile{ usg_file_path = file,
                                    usg_file_hash = old_hash } =
   liftIO $
-    handleIO handle $ do
+    handleIO handler $ do
       new_hash <- getFileHash file
       if (old_hash /= new_hash)
          then return recomp
          else return UpToDate
  where
-   recomp = RecompBecause (file ++ " changed")
-   handle =
+   recomp  = RecompBecause (file ++ " changed")
+   handler =
 #if defined(DEBUG)
        \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
 #else
diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs
index 7ea450067e..93869b35dd 100644
--- a/compiler/GHC/Runtime/Debugger.hs
+++ b/compiler/GHC/Runtime/Debugger.hs
@@ -40,6 +40,7 @@ import GHC.Driver.Session
 import GHC.Utils.Exception
 
 import Control.Monad
+import Control.Monad.Catch as MC
 import Data.List ( (\\) )
 import Data.Maybe
 import Data.IORef
@@ -192,7 +193,7 @@ showTerm term = do
              return $ Just $ cparen (prec >= myprec && needsParens txt)
                                     (text txt)
             else return Nothing
-         `gfinally` do
+         `MC.finally` do
            setSession hsc_env
            GHC.setSessionDynFlags dflags
   cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} =
@@ -228,7 +229,7 @@ pprTypeAndContents id = do
       let depthBound = 100
       -- If the value is an exception, make sure we catch it and
       -- show the exception, rather than propagating the exception out.
-      e_term <- gtry $ GHC.obtainTermFromId depthBound False id
+      e_term <- MC.try $ GHC.obtainTermFromId depthBound False id
       docs_term <- case e_term of
                       Right term -> showTerm term
                       Left  exn  -> return (text "*** Exception:" <+>
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index edf8163a43..9656078736 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -108,6 +108,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import GHC.Data.StringBuffer (stringToStringBuffer)
 import Control.Monad
+import Control.Monad.Catch as MC
 import Data.Array
 import GHC.Utils.Exception
 import Unsafe.Coerce ( unsafeCoerce )
@@ -291,7 +292,7 @@ withVirtualCWD m = do
             setSession hsc_env{  hsc_IC = old_IC{ ic_cwd = Just virt_dir } }
             liftIO $ setCurrentDirectory orig_dir
 
-      gbracket set_cwd reset_cwd $ \_ -> m
+      MC.bracket set_cwd reset_cwd $ \_ -> m
 
 parseImportDecl :: GhcMonad m => String -> m (ImportDecl GhcPs)
 parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 1495c5c82e..b261a2b690 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -65,7 +65,7 @@ import GHC.Driver.Types
 import GHC.Types.Unique.FM
 import GHC.Utils.Panic
 import GHC.Driver.Session
-import GHC.Utils.Exception
+import GHC.Utils.Exception as Ex
 import GHC.Types.Basic
 import GHC.Data.FastString
 import GHC.Utils.Misc
@@ -85,6 +85,7 @@ import GHC.Driver.Ways
 import Control.Concurrent
 import Control.Monad
 import Control.Monad.IO.Class
+import Control.Monad.Catch as MC (mask, onException)
 import Data.Binary
 import Data.Binary.Put
 import Data.ByteString (ByteString)
@@ -211,17 +212,17 @@ hscInterp hsc_env = case hsc_interp hsc_env of
 -- | Grab a lock on the 'IServ' and do something with it.
 -- Overloaded because this is used from TcM as well as IO.
 withIServ
-  :: (MonadIO m, ExceptionMonad m)
+  :: (ExceptionMonad m)
   => IServConfig -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
 withIServ conf (IServ mIServState) action = do
-  gmask $ \restore -> do
+  MC.mask $ \restore -> do
     state <- liftIO $ takeMVar mIServState
 
     iserv <- case state of
       -- start the external iserv process if we haven't done so yet
       IServPending ->
          liftIO (spawnIServ conf)
-           `gonException` (liftIO $ putMVar mIServState state)
+           `MC.onException` (liftIO $ putMVar mIServState state)
 
       IServRunning inst -> return inst
 
@@ -234,7 +235,7 @@ withIServ conf (IServ mIServState) action = do
         iservCall iserv (FreeHValueRefs (iservPendingFrees iserv))
       -- run the inner action
       restore $ action iserv')
-          `gonException` (liftIO $ putMVar mIServState (IServRunning iserv'))
+          `MC.onException` (liftIO $ putMVar mIServState (IServRunning iserv'))
     liftIO $ putMVar mIServState (IServRunning iserv'')
     return a
 
@@ -584,7 +585,7 @@ stopInterp hsc_env = case hsc_interp hsc_env of
   Just InternalInterp -> pure ()
 #endif
   Just (ExternalInterp _ (IServ mstate)) ->
-    gmask $ \_restore -> modifyMVar_ mstate $ \state -> do
+    MC.mask $ \_restore -> modifyMVar_ mstate $ \state -> do
       case state of
         IServPending    -> pure state -- already stopped
         IServRunning i  -> do
@@ -614,7 +615,7 @@ runWithPipes createProc prog opts = do
     wh <- mkHandle wfd2
     return (ph, rh, wh)
       where mkHandle :: CInt -> IO Handle
-            mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
+            mkHandle fd = (fdToHandle fd) `Ex.onException` (c__close fd)
 
 #else
 runWithPipes createProc prog opts = do
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 2ac1fc12d2..9ae8270558 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -72,6 +72,7 @@ import Data.IORef
 import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition)
 import Data.Maybe
 import Control.Concurrent.MVar
+import qualified Control.Monad.Catch as MC
 
 import System.FilePath
 import System.Directory
@@ -216,7 +217,7 @@ linkDependencies hsc_env pls span needed_mods = do
 withExtendedLinkEnv :: (ExceptionMonad m) =>
                        DynLinker -> [(Name,ForeignHValue)] -> m a -> m a
 withExtendedLinkEnv dl new_env action
-    = gbracket (liftIO $ extendLinkEnv dl new_env)
+    = MC.bracket (liftIO $ extendLinkEnv dl new_env)
                (\_ -> reset_old_env)
                (\_ -> action)
     where
diff --git a/compiler/GHC/SysTools/FileCleanup.hs b/compiler/GHC/SysTools/FileCleanup.hs
index f72480d65f..b695a72a28 100644
--- a/compiler/GHC/SysTools/FileCleanup.hs
+++ b/compiler/GHC/SysTools/FileCleanup.hs
@@ -299,7 +299,7 @@ withTempDirectory targetDir template =
     (ignoringIOErrors . removeDirectoryRecursive)
 
 ignoringIOErrors :: IO () -> IO ()
-ignoringIOErrors ioe = ioe `catch` (\e -> const (return ()) (e :: IOError))
+ignoringIOErrors ioe = ioe `catchIO` const (return ())
 
 
 createTempDirectory :: FilePath -> String -> IO FilePath
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index ee2f664571..be5549d577 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -186,7 +186,7 @@ runClang dflags args = traceToolCommand dflags "clang" $ do
       args1 = map Option (getOpts dflags opt_a)
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  Exception.catch (do
+  catch (do
         runSomethingFiltered dflags id "Clang (Assembler)" clang args2 Nothing mb_env
     )
     (\(err :: SomeException) -> do
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index 96f1e11f3a..eb775aa4a3 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -89,6 +89,7 @@ import Data.Time
 import Debug.Trace
 import Control.Monad
 import Control.Monad.IO.Class
+import Control.Monad.Catch as MC (handle)
 import System.IO
 import System.IO.Error  ( catchIOError )
 import GHC.Conc         ( getAllocationCounter )
@@ -800,7 +801,7 @@ logOutput dflags msg
 
 prettyPrintGhcErrors :: ExceptionMonad m => DynFlags -> m a -> m a
 prettyPrintGhcErrors dflags
-    = ghandle $ \e -> case e of
+    = MC.handle $ \e -> case e of
                       PprPanic str doc ->
                           pprDebugAndThen dflags panic (text str) doc
                       PprSorry str doc ->
diff --git a/compiler/GHC/Utils/Exception.hs b/compiler/GHC/Utils/Exception.hs
index e84221cdbe..49fa19bd47 100644
--- a/compiler/GHC/Utils/Exception.hs
+++ b/compiler/GHC/Utils/Exception.hs
@@ -1,4 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# LANGUAGE ConstraintKinds #-}
+
 module GHC.Utils.Exception
     (
     module Control.Exception,
@@ -9,75 +11,18 @@ module GHC.Utils.Exception
 import GHC.Prelude
 
 import Control.Exception
+import Control.Exception as CE
 import Control.Monad.IO.Class
+import Control.Monad.Catch
 
+-- Monomorphised versions of exception-handling utilities
 catchIO :: IO a -> (IOException -> IO a) -> IO a
-catchIO = Control.Exception.catch
+catchIO = CE.catch
 
 handleIO :: (IOException -> IO a) -> IO a -> IO a
 handleIO = flip catchIO
 
 tryIO :: IO a -> IO (Either IOException a)
-tryIO = try
-
--- | A monad that can catch exceptions.  A minimal definition
--- requires a definition of 'gcatch'.
---
--- Implementations on top of 'IO' should implement 'gmask' to
--- eventually call the primitive 'Control.Exception.mask'.
--- These are used for
--- implementations that support asynchronous exceptions.  The default
--- implementations of 'gbracket' and 'gfinally' use 'gmask'
--- thus rarely require overriding.
---
-class MonadIO m => ExceptionMonad m where
-
-  -- | Generalised version of 'Control.Exception.catch', allowing an arbitrary
-  -- exception handling monad instead of just 'IO'.
-  gcatch :: Exception e => m a -> (e -> m a) -> m a
-
-  -- | Generalised version of 'Control.Exception.mask_', allowing an arbitrary
-  -- exception handling monad instead of just 'IO'.
-  gmask :: ((m a -> m a) -> m b) -> m b
-
-  -- | Generalised version of 'Control.Exception.bracket', allowing an arbitrary
-  -- exception handling monad instead of just 'IO'.
-  gbracket :: m a -> (a -> m b) -> (a -> m c) -> m c
-
-  -- | Generalised version of 'Control.Exception.finally', allowing an arbitrary
-  -- exception handling monad instead of just 'IO'.
-  gfinally :: m a -> m b -> m a
-
-  gbracket before after thing =
-    gmask $ \restore -> do
-      a <- before
-      r <- restore (thing a) `gonException` after a
-      _ <- after a
-      return r
-
-  a `gfinally` sequel =
-    gmask $ \restore -> do
-      r <- restore a `gonException` sequel
-      _ <- sequel
-      return r
-
-instance ExceptionMonad IO where
-  gcatch    = Control.Exception.catch
-  gmask f   = mask (\x -> f x)
-
-gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
-gtry act = gcatch (act >>= \a -> return (Right a))
-                  (\e -> return (Left e))
-
--- | Generalised version of 'Control.Exception.handle', allowing an arbitrary
--- exception handling monad instead of just 'IO'.
-ghandle :: (ExceptionMonad m, Exception e) => (e -> m a) -> m a -> m a
-ghandle = flip gcatch
-
--- | Always executes the first argument.  If this throws an exception the
--- second argument is executed and the exception is raised again.
-gonException :: (ExceptionMonad m) => m a -> m b -> m a
-gonException ioA cleanup = ioA `gcatch` \e ->
-                             do _ <- cleanup
-                                liftIO $ throwIO (e :: SomeException)
+tryIO = CE.try
 
+type ExceptionMonad m = (MonadCatch m, MonadThrow m, MonadMask m, MonadIO m)
diff --git a/compiler/GHC/Utils/Panic.hs b/compiler/GHC/Utils/Panic.hs
index 48695e25d4..9d960644b6 100644
--- a/compiler/GHC/Utils/Panic.hs
+++ b/compiler/GHC/Utils/Panic.hs
@@ -36,6 +36,7 @@ import GHC.Utils.Panic.Plain
 import GHC.Utils.Exception as Exception
 
 import Control.Monad.IO.Class
+import qualified Control.Monad.Catch as MC
 import Control.Concurrent
 import Data.Typeable      ( cast )
 import Debug.Trace        ( trace )
@@ -155,7 +156,7 @@ throwGhcExceptionIO :: GhcException -> IO a
 throwGhcExceptionIO = Exception.throwIO
 
 handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
-handleGhcException = ghandle
+handleGhcException = MC.handle
 
 panicDoc, sorryDoc, pgmErrorDoc :: String -> SDoc -> a
 panicDoc    x doc = throwGhcException (PprPanic        x doc)
@@ -197,7 +198,7 @@ signalHandlersRefCount = unsafePerformIO $ newMVar (0,Nothing)
 
 -- | Temporarily install standard signal handlers for catching ^C, which just
 -- throw an exception in the current thread.
-withSignalHandlers :: (ExceptionMonad m, MonadIO m) => m a -> m a
+withSignalHandlers :: ExceptionMonad m => m a -> m a
 withSignalHandlers act = do
   main_thread <- liftIO myThreadId
   wtid <- liftIO (mkWeakThreadId main_thread)
@@ -256,4 +257,4 @@ withSignalHandlers act = do
         (c,oldHandlers) -> return (c-1,oldHandlers)
 
   mayInstallHandlers
-  act `gfinally` mayUninstallHandlers
+  act `MC.finally` mayUninstallHandlers