Windows-only fixes for moving concurrent out of base

1 files changed, 10 insertions, 1 deletions

diff --git a/libraries/base/GHC/ConsoleHandler.hs b/libraries/base/GHC/ConsoleHandler.hs
index cabaa53c49..7587d94e71 100644
--- a/libraries/base/GHC/ConsoleHandler.hs
+++ b/libraries/base/GHC/ConsoleHandler.hs
@@ -37,7 +37,7 @@ import Foreign.C
 import GHC.IOBase
 import GHC.Conc
 import GHC.Handle
-import Control.Concurrent.MVar
+import Control.Exception (onException)
 
 data Handler
  = Default
@@ -140,4 +140,13 @@ flushConsole h =
 
 foreign import ccall unsafe "consUtils.h flush_input_console__"
         flush_console_fd :: CInt -> IO CInt
+
+-- XXX Copied from Control.Concurrent.MVar
+modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
+modifyMVar m io =
+  block $ do
+    a      <- takeMVar m
+    (a',b) <- unblock (io a) `onException` putMVar m a
+    putMVar m a'
+    return b
 #endif /* mingw32_HOST_OS */