projects
/
ghc-base.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
92411e7
)
Windows-only fixes for moving concurrent out of base
author
Ian Lynagh
<igloo@earth.li>
Sun, 24 Aug 2008 16:41:46 +0000
(16:41 +0000)
committer
Ian Lynagh
<igloo@earth.li>
Sun, 24 Aug 2008 16:41:46 +0000
(16:41 +0000)
GHC/ConsoleHandler.hs
patch
|
blob
|
history
diff --git
a/GHC/ConsoleHandler.hs
b/GHC/ConsoleHandler.hs
index
cabaa53
..
7587d94
100644
(file)
--- 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 GHC.IOBase
import GHC.Conc
import GHC.Handle
-import Control.Concurrent.MVar
+import Control.Exception (onException)
data Handler
= Default
data Handler
= Default
@@
-140,4
+140,13
@@
flushConsole h =
foreign import ccall unsafe "consUtils.h flush_input_console__"
flush_console_fd :: CInt -> IO CInt
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 */
#endif /* mingw32_HOST_OS */