Remove redundant imports, now that NoImplicitPrelude does not imply RebindableSyntax

[ghc-base.git] / Control / Concurrent.hs

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index b9e52cb..6122a10 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Concurrent
@@ -27,6 +28,7 @@ module Control.Concurrent (
 
         forkIO,
 #ifdef __GLASGOW_HASKELL__
+        forkIOUnmasked,
         killThread,
         throwTo,
 #endif
@@ -97,12 +99,10 @@ import Control.Exception.Base as Exception
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exception
 import GHC.Conc         ( ThreadId(..), myThreadId, killThread, yield,
-                          threadDelay, forkIO, childHandler )
+                          threadDelay, forkIO, forkIOUnmasked, childHandler )
 import qualified GHC.Conc
-import GHC.TopHandler   ( reportStackOverflow, reportError )
-import GHC.IOBase       ( IO(..) )
-import GHC.IOBase       ( unsafeInterleaveIO )
-import GHC.IOBase       ( newIORef, readIORef, writeIORef )
+import GHC.IO           ( IO(..), unsafeInterleaveIO, unsafeUnmask )
+import GHC.IORef        ( newIORef, readIORef, writeIORef )
 import GHC.Base
 
 import System.Posix.Types ( Fd )
@@ -113,7 +113,6 @@ import Control.Monad    ( when )
 #ifdef mingw32_HOST_OS
 import Foreign.C
 import System.IO
-import GHC.Handle
 #endif
 #endif
 
@@ -344,6 +343,7 @@ foreign export ccall forkOS_entry
 foreign import ccall "forkOS_entry" forkOS_entry_reimported
     :: StablePtr (IO ()) -> IO ()
 
+forkOS_entry :: StablePtr (IO ()) -> IO ()
 forkOS_entry stableAction = do
         action <- deRefStablePtr stableAction
         action
@@ -351,19 +351,22 @@ forkOS_entry stableAction = do
 foreign import ccall forkOS_createThread
     :: StablePtr (IO ()) -> IO CInt
 
+failNonThreaded :: IO a
 failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
                        ++"(use ghc -threaded when linking)"
 
 forkOS action0
     | rtsSupportsBoundThreads = do
         mv <- newEmptyMVar
-        b <- Exception.blocked
+        b <- Exception.getMaskingState
         let
-            -- async exceptions are blocked in the child if they are blocked
+            -- async exceptions are masked in the child if they are masked
             -- in the parent, as for forkIO (see #1048). forkOS_createThread
-            -- creates a thread with exceptions blocked by default.
-            action1 | b = action0
-                    | otherwise = unblock action0
+            -- creates a thread with exceptions masked by default.
+            action1 = case b of
+                        Unmasked -> unsafeUnmask action0
+                        MaskedInterruptible -> action0
+                        MaskedUninterruptible -> uninterruptibleMask_ action0
 
             action_plus = Exception.catch action1 childHandler
 
@@ -430,8 +433,11 @@ runInUnboundThread action = do
     if bound
         then do
             mv <- newEmptyMVar
-            forkIO (Exception.try action >>= putMVar mv)
-            takeMVar mv >>= \either -> case either of
+            b <- blocked
+            _ <- mask $ \restore -> forkIO $
+              Exception.try (if b then action else restore action) >>=
+              putMVar mv
+            takeMVar mv >>= \ei -> case ei of
                 Left exception -> Exception.throw (exception :: SomeException)
                 Right result -> return result
         else action
@@ -453,7 +459,8 @@ threadWaitRead fd
   -- and this only works with -threaded.
   | threaded  = withThread (waitFd fd 0)
   | otherwise = case fd of
-                  0 -> do hWaitForInput stdin (-1); return ()
+                  0 -> do _ <- hWaitForInput stdin (-1)
+                          return ()
                         -- hWaitForInput does work properly, but we can only
                         -- do this for stdin since we know its FD.
                   _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"
@@ -478,7 +485,7 @@ foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 withThread :: IO a -> IO a
 withThread io = do
   m <- newEmptyMVar
-  forkIO $ try io >>= putMVar m
+  _ <- mask_ $ forkIO $ try io >>= putMVar m
   x <- takeMVar m
   case x of
     Right a -> return a
@@ -486,11 +493,11 @@ withThread io = do
 
 waitFd :: Fd -> CInt -> IO ()
 waitFd fd write = do
-   throwErrnoIfMinus1 "fdReady" $
+   throwErrnoIfMinus1_ "fdReady" $
         fdReady (fromIntegral fd) write (fromIntegral iNFINITE) 0
-   return ()
 
-iNFINITE = 0xFFFFFFFF :: CInt -- urgh
+iNFINITE :: CInt
+iNFINITE = 0xFFFFFFFF -- urgh
 
 foreign import ccall safe "fdReady"
   fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
@@ -522,7 +529,7 @@ foreign import ccall safe "fdReady"
       The "System.IO" library manages multiplexing in its own way.  On
       Windows systems it uses @safe@ foreign calls to ensure that
       threads doing I\/O operations don't block the whole runtime,
-      whereas on Unix systems all the currently blocked I\/O reqwests
+      whereas on Unix systems all the currently blocked I\/O requests
       are managed by a single thread (the /IO manager thread/) using
       @select@.