From: Ian Lynagh <igloo@earth.li>
Date: Sun, 24 Aug 2008 16:41:46 +0000 (+0000)
Subject: Windows-only fixes for moving concurrent out of base
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=16875d8036c552e5920e219b972b764387971dcf;p=ghc-base.git

Windows-only fixes for moving concurrent out of base
---

diff --git a/GHC/ConsoleHandler.hs b/GHC/ConsoleHandler.hs
index cabaa53..7587d94 100644
--- a/GHC/ConsoleHandler.hs
+++ b/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 */