Remove gblock and gunblock

4 files changed, 6 insertions, 30 deletions

diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
index 6b8c7bacdf..02769bc05d 100644
--- a/compiler/main/GhcMonad.hs
+++ b/compiler/main/GhcMonad.hs
@@ -110,8 +110,6 @@ instance MonadFix Ghc where
 instance ExceptionMonad Ghc where
   gcatch act handle =
       Ghc $ \s -> unGhc act s `gcatch` \e -> unGhc (handle e) s
-  gblock (Ghc m)   = Ghc $ \s -> gblock (m s)
-  gunblock (Ghc m) = Ghc $ \s -> gunblock (m s)
   gmask f =
       Ghc $ \s -> gmask $ \io_restore ->
                              let
@@ -169,8 +167,6 @@ instance MonadIO m => MonadIO (GhcT m) where
 instance ExceptionMonad m => ExceptionMonad (GhcT m) where
   gcatch act handle =
       GhcT $ \s -> unGhcT act s `gcatch` \e -> unGhcT (handle e) s
-  gblock (GhcT m) = GhcT $ \s -> gblock (m s)
-  gunblock (GhcT m) = GhcT $ \s -> gunblock (m s)
   gmask f =
       GhcT $ \s -> gmask $ \io_restore ->
                            let
diff --git a/compiler/utils/Exception.hs b/compiler/utils/Exception.hs
index b4908997a8..850393e359 100644
--- a/compiler/utils/Exception.hs
+++ b/compiler/utils/Exception.hs
@@ -21,11 +21,11 @@ tryIO = try
 -- | A monad that can catch exceptions.  A minimal definition
 -- requires a definition of 'gcatch'.
 --
--- Implementations on top of 'IO' should implement 'gblock' and 'gunblock' to
--- eventually call the primitives 'Control.Exception.block' and
--- 'Control.Exception.unblock' respectively.  These are used for
+-- 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 'gblock' and 'gunblock'
+-- implementations of 'gbracket' and 'gfinally' use 'gmask'
 -- thus rarely require overriding.
 --
 class MonadIO m => ExceptionMonad m where
@@ -46,20 +46,6 @@ class MonadIO m => ExceptionMonad m where
   -- exception handling monad instead of just 'IO'.
   gfinally :: m a -> m b -> m a
 
-  -- | DEPRECATED, here for backwards compatibilty.  Instances can
-  -- define either 'gmask', or both 'block' and 'unblock'.
-  gblock   :: m a -> m a
-  -- | DEPRECATED, here for backwards compatibilty  Instances can
-  -- define either 'gmask', or both 'block' and 'unblock'.
-  gunblock :: m a -> m a
-  -- XXX we're keeping these two methods for the time being because we
-  -- have to interact with Haskeline's MonadException class which
-  -- still has block/unblock; see GhciMonad.hs.
-
-  gmask    f = gblock (f gunblock)
-  gblock   f = gmask (\_ -> f)
-  gunblock f = f -- XXX wrong; better override this if you need it
-
   gbracket before after thing =
     gmask $ \restore -> do
       a <- before
@@ -76,8 +62,6 @@ class MonadIO m => ExceptionMonad m where
 instance ExceptionMonad IO where
   gcatch    = Control.Exception.catch
   gmask f   = mask (\x -> f x)
-  gblock    = block
-  gunblock  = unblock
 
 gtry :: (ExceptionMonad m, Exception e) => m a -> m (Either e a)
 gtry act = gcatch (act >>= \a -> return (Right a))
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index 2a6badbff0..e61e1409de 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -204,8 +204,6 @@ instance GhcMonad (InputT GHCi) where
 
 instance ExceptionMonad GHCi where
   gcatch m h = GHCi $ \r -> unGHCi m r `gcatch` (\e -> unGHCi (h e) r)
-  gblock (GHCi m)   = GHCi $ \r -> gblock (m r)
-  gunblock (GHCi m) = GHCi $ \r -> gunblock (m r)
   gmask f =
       GHCi $ \s -> gmask $ \io_restore ->
                              let
@@ -227,9 +225,6 @@ instance ExceptionMonad (InputT GHCi) where
   gcatch = Haskeline.catch
   gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)
 
-  gblock = Haskeline.liftIOOp_ gblock
-  gunblock = Haskeline.liftIOOp_ gunblock
-
 isOptionSet :: GHCiOption -> GHCi Bool
 isOptionSet opt
  = do st <- getGHCiState
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index ec7e5225df..5b3e572650 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -2944,7 +2944,8 @@ showException se =
 -- may never be delivered.  Thanks to Marcin for pointing out the bug.
 
 ghciHandle :: ExceptionMonad m => (SomeException -> m a) -> m a -> m a
-ghciHandle h m = gcatch m $ \e -> gunblock (h e)
+ghciHandle h m = gmask $ \restore ->
+                 gcatch (restore m) $ \e -> restore (h e)
 
 ghciTry :: GHCi a -> GHCi (Either SomeException a)
 ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)