X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2FGhciMonad.hs;h=5494b4ea4c02d8f76db901a0b8b336ef70eade2e;hp=f1859d7d072eb3613ea4f72626288dec69de3c60;hb=75736ff2a36d165eed7c216b3fd510d525094b79;hpb=dc6ba4ba71995d0f3c5b126397571d2b5e771dee

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index f1859d7..5494b4e 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -189,6 +189,12 @@ 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
+                                g_restore (GHCi m) = GHCi $ \s' -> io_restore (m s')
+                             in
+                                unGHCi (f g_restore) s
 
 instance WarnLogMonad GHCi where
   setWarnings warns = liftGhc $ setWarnings warns
@@ -201,11 +207,14 @@ instance Haskeline.MonadException GHCi where
   catch = gcatch
   block = gblock
   unblock = gunblock
+  -- XXX when Haskeline's MonadException changes, we can drop our 
+  -- deprecated block/unblock methods
 
 instance ExceptionMonad (InputT GHCi) where
-    gcatch = Haskeline.catch
-    gblock = Haskeline.block
-    gunblock = Haskeline.unblock
+  gcatch = Haskeline.catch
+  gmask f = Haskeline.block (f Haskeline.unblock) -- slightly wrong
+  gblock = Haskeline.block
+  gunblock = Haskeline.unblock
 
 -- for convenience...
 getPrelude :: GHCi Module