doc typo

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

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 2d9cf57..a25e659 100644 (file)
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -430,7 +430,10 @@ runInUnboundThread action = do
     if bound
         then do
             mv <- newEmptyMVar
-            forkIO (Exception.try action >>= putMVar mv)
+            b <- blocked
+            _ <- block $ forkIO $
+              Exception.try (if b then action else unblock action) >>=
+              putMVar mv
             takeMVar mv >>= \ei -> case ei of
                 Left exception -> Exception.throw (exception :: SomeException)
                 Right result -> return result
@@ -453,7 +456,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 +482,7 @@ foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 withThread :: IO a -> IO a
 withThread io = do
   m <- newEmptyMVar
-  forkIO $ try io >>= putMVar m
+  _ <- block $ forkIO $ try io >>= putMVar m
   x <- takeMVar m
   case x of
     Right a -> return a
@@ -486,9 +490,8 @@ withThread io = do
 
 waitFd :: Fd -> CInt -> IO ()
 waitFd fd write = do
-   throwErrnoIfMinus1 "fdReady" $
+   throwErrnoIfMinus1_ "fdReady" $
         fdReady (fromIntegral fd) write (fromIntegral iNFINITE) 0
-   return ()
 
 iNFINITE :: CInt
 iNFINITE = 0xFFFFFFFF -- urgh