From: Ian Lynagh <igloo@earth.li>
Date: Sat, 11 Jul 2009 00:43:51 +0000 (+0000)
Subject: Fix build on Windows
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6e20be4ad2cb641f29e9972aaacd775f82487719;p=ghc-base.git

Fix build on Windows
---

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index 7ec65f2..75ee52e 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -453,7 +453,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 +479,7 @@ foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
 withThread :: IO a -> IO a
 withThread io = do
   m <- newEmptyMVar
-  forkIO $ try io >>= putMVar m
+  _ <- forkIO $ try io >>= putMVar m
   x <- takeMVar m
   case x of
     Right a -> return a
@@ -486,9 +487,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
diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index f182d3b..e3f5356 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -110,12 +110,14 @@ import Data.Typeable
 
 #ifndef mingw32_HOST_OS
 import Data.Dynamic
-import Control.Monad
 #endif
+import Control.Monad
 import Data.Maybe
 
 import GHC.Base
+#ifndef mingw32_HOST_OS
 import GHC.Debug
+#endif
 import {-# SOURCE #-} GHC.IO.Handle ( hFlush )
 import {-# SOURCE #-} GHC.IO.Handle.FD ( stdout )
 import GHC.IO
@@ -821,7 +823,7 @@ prodServiceThread = do
 startIOManagerThread :: IO ()
 startIOManagerThread = do
   wakeup <- c_getIOManagerEvent
-  forkIO $ service_loop wakeup []
+  _ <- forkIO $ service_loop wakeup []
   return ()
 
 service_loop :: HANDLE          -- read end of pipe
@@ -875,7 +877,7 @@ start_console_handler :: Word32 -> IO ()
 start_console_handler r =
   case toWin32ConsoleEvent r of
      Just x  -> withMVar win32ConsoleHandler $ \handler -> do
-                    forkIO (handler x)
+                    _ <- forkIO (handler x)
                     return ()
      Nothing -> return ()
 
@@ -1106,6 +1108,17 @@ runHandlers' p_info sig = do
                     Just (f,_)  -> do _ <- forkIO (f p_info)
                                       return ()
 
+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)
+
 foreign import ccall "setIOManagerPipe"
   c_setIOManagerPipe :: CInt -> IO ()
 
@@ -1308,15 +1321,4 @@ 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}
diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs
index 2b21914..d4d28bf 100644
--- a/GHC/IO/FD.hs
+++ b/GHC/IO/FD.hs
@@ -219,7 +219,7 @@ mkFD fd iomode mb_stat is_socket is_nonblock = do
                    _ -> True
 
 #ifdef mingw32_HOST_OS
-    setmode fd True -- unconditionally set binary mode
+    _ <- setmode fd True -- unconditionally set binary mode
     let _ = (dev,ino,write) -- warning suppression
 #endif
 
diff --git a/GHC/IO/Handle/FD.hs b/GHC/IO/Handle/FD.hs
index deedb7f..6922732 100644
--- a/GHC/IO/Handle/FD.hs
+++ b/GHC/IO/Handle/FD.hs
@@ -87,7 +87,8 @@ stdHandleFinalizer fp m = do
 -- translation that the CRT IO library does.
 setBinaryMode :: FD -> IO ()
 #ifdef mingw32_HOST_OS
-setBinaryMode fd = do setmode (fdFD fd) True; return ()
+setBinaryMode fd = do _ <- setmode (fdFD fd) True
+                      return ()
 #else
 setBinaryMode _ = return ()
 #endif
diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs
index 5b07bad..2836111 100644
--- a/GHC/TopHandler.lhs
+++ b/GHC/TopHandler.lhs
@@ -69,7 +69,7 @@ runMainIO main =
 install_interrupt_handler :: IO () -> IO ()
 #ifdef mingw32_HOST_OS
 install_interrupt_handler handler = do
-  GHC.ConsoleHandler.installHandler $
+  _ <- GHC.ConsoleHandler.installHandler $
      Catch $ \event -> 
         case event of
            ControlC -> handler