Fix some "warn-unused-do-bind" warnings where we want to ignore the value

[ghc-base.git] / GHC / Conc.lhs

diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index 444d3fc..67a2199 100644 (file)
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -104,6 +104,10 @@ import System.Posix.Internals
 import Foreign
 import Foreign.C
 
+#ifdef mingw32_HOST_OS
+import Data.Typeable
+#endif
+
 #ifndef mingw32_HOST_OS
 import Data.Dynamic
 import Control.Monad
@@ -111,6 +115,7 @@ import Control.Monad
 import Data.Maybe
 
 import GHC.Base
+import GHC.Debug
 import {-# SOURCE #-} GHC.IO.Handle ( hFlush )
 import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )
 import GHC.IO
@@ -126,7 +131,7 @@ import GHC.Arr          ( inRange )
 #endif
 #ifdef mingw32_HOST_OS
 import GHC.Real         ( div )
-import GHC.Ptr          ( FunPtr(..) )
+import GHC.Ptr
 #endif
 #ifdef mingw32_HOST_OS
 import GHC.Read         ( Read )
@@ -536,7 +541,7 @@ checkInv (STM m) = STM (\s -> (check# m) s)
 -- of those points then the transaction violating it is aborted
 -- and the exception raised by the invariant is propagated.
 alwaysSucceeds :: STM a -> STM ()
-alwaysSucceeds i = do ( do i ; retry ) `orElse` ( return () ) 
+alwaysSucceeds i = do ( i >> retry ) `orElse` ( return () ) 
                       checkInv i
 
 -- | always is a variant of alwaysSucceeds in which the invariant is
@@ -843,9 +848,7 @@ service_loop wakeup old_delays = do
                 _ | r2 == io_MANAGER_DIE    -> return True
                 0 -> return False -- spurious wakeup
                 _ -> do start_console_handler (r2 `shiftR` 1); return False
-        if exit
-          then return ()
-          else service_cont wakeup delays'
+        unless exit $ service_cont wakeup delays'
 
     _other -> service_cont wakeup delays' -- probably timeout        
 
@@ -950,7 +953,7 @@ foreign import stdcall "WaitForSingleObject"
 startIOManagerThread :: IO ()
 startIOManagerThread = do
         allocaArray 2 $ \fds -> do
-        throwErrnoIfMinus1 "startIOManagerThread" (c_pipe fds)
+        throwErrnoIfMinus1_ "startIOManagerThread" (c_pipe fds)
         rd_end <- peekElemOff fds 0
         wr_end <- peekElemOff fds 1
         setNonBlockingFD wr_end True -- writes happen in a signal handler, we
@@ -959,7 +962,7 @@ startIOManagerThread = do
         setCloseOnExec wr_end
         writeIORef stick (fromIntegral wr_end)
         c_setIOManagerPipe wr_end
-        forkIO $ do
+        _ <- forkIO $ do
             allocaBytes sizeofFdSet   $ \readfds -> do
             allocaBytes sizeofFdSet   $ \writefds -> do 
             allocaBytes sizeofTimeVal $ \timeval -> do
@@ -1024,7 +1027,8 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
         if b == 0 
           then return False
           else alloca $ \p -> do 
-                 c_read (fromIntegral wakeup) p 1
+                 warnErrnoIfMinus1_ "service_loop" $
+                     c_read (fromIntegral wakeup) p 1
                  s <- peek p            
                  case s of
                   _ | s == io_MANAGER_WAKEUP -> return False
@@ -1043,9 +1047,9 @@ service_loop wakeup readfds writefds ptimeval old_reqs old_delays = do
                        runHandlers' fp (fromIntegral s)
                        return False
 
-  if exit then return () else do
+  unless exit $ do
 
-  atomicModifyIORef prodding (\_ -> (False,False))
+  atomicModifyIORef prodding (\_ -> (False, ()))
 
   reqs' <- if wakeup_all then do wakeupAll reqs; return []
                          else completeRequests reqs readfds writefds []
@@ -1073,14 +1077,14 @@ syncIOManager = do
   atomicModifyIORef sync (\old -> (m:old,()))
   fd <- readIORef stick
   with io_MANAGER_SYNC $ \pbuf -> do 
-    c_write (fromIntegral fd) pbuf 1; return ()
+    warnErrnoIfMinus1_ "syncIOManager" $ c_write (fromIntegral fd) pbuf 1
   takeMVar m
 
 wakeupIOManager :: IO ()
 wakeupIOManager = do
   fd <- readIORef stick
   with io_MANAGER_WAKEUP $ \pbuf -> do 
-    c_write (fromIntegral fd) pbuf 1; return ()
+    warnErrnoIfMinus1_ "wakeupIOManager" $ c_write (fromIntegral fd) pbuf 1
 
 -- For the non-threaded RTS
 runHandlers :: Ptr Word8 -> Int -> IO ()
@@ -1100,7 +1104,8 @@ runHandlers' p_info sig = do
          else do handler <- unsafeReadIOArray arr int
                  case handler of
                     Nothing -> return ()
-                    Just (f,_)  -> do forkIO (f p_info); return ()
+                    Just (f,_)  -> do _ <- forkIO (f p_info)
+                                      return ()
 
 foreign import ccall "setIOManagerPipe"
   c_setIOManagerPipe :: CInt -> IO ()
@@ -1304,4 +1309,16 @@ setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler
 
 getUncaughtExceptionHandler :: IO (SomeException -> IO ())
 getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler
+
+warnErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
+warnErrnoIfMinus1_ what io
+    = do r <- io
+         when (r == -1) $ do
+             errno <- getErrno
+             str <- strerror errno >>= peekCString
+             when (r == -1) $
+                 debugErrLn ("Warning: " ++ what ++ " failed: " ++ str)
+
+foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)
+
 \end{code}