From: Ian Lynagh Date: Sat, 23 Aug 2008 00:22:49 +0000 (+0000) Subject: Fix Windows-only warnings X-Git-Tag: 6_10_branch_has_been_forked~27 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=9a101ce92ae850645471b8b5221215cdc5f916de;p=ghc-base.git Fix Windows-only warnings --- diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs index f22aca8..7f252f2 100644 --- a/Control/Concurrent.hs +++ b/Control/Concurrent.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Concurrent @@ -491,7 +492,8 @@ waitFd fd write = do 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 diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs index 31064df..6239278 100644 --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -1,5 +1,6 @@ \begin{code} {-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- -- | @@ -702,7 +703,7 @@ asyncDoProc (FunPtr proc) (Ptr param) = -- the 'length' value is ignored; simplifies implementation of -- the async*# primops to have them all return the same result. IO $ \s -> case asyncDoProc# proc param s of - (# s', len#, err# #) -> (# s', I# err# #) + (# s', _len#, err# #) -> (# s', I# err# #) -- to aid the use of these primops by the IO Handle implementation, -- provide the following convenience funs: @@ -923,13 +924,15 @@ service_loop wakeup old_delays = do _other -> service_cont wakeup delays' -- probably timeout +service_cont :: HANDLE -> [DelayReq] -> IO () service_cont wakeup delays = do atomicModifyIORef prodding (\_ -> (False,False)) service_loop wakeup delays -- must agree with rts/win32/ThrIOManager.c -io_MANAGER_WAKEUP = 0xffffffff :: Word32 -io_MANAGER_DIE = 0xfffffffe :: Word32 +io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word32 +io_MANAGER_WAKEUP = 0xffffffff +io_MANAGER_DIE = 0xfffffffe data ConsoleEvent = ControlC @@ -948,6 +951,7 @@ start_console_handler r = return () Nothing -> return () +toWin32ConsoleEvent :: Num a => a -> Maybe ConsoleEvent toWin32ConsoleEvent ev = case ev of 0 {- CTRL_C_EVENT-} -> Just ControlC @@ -965,6 +969,7 @@ stick :: IORef HANDLE {-# NOINLINE stick #-} stick = unsafePerformIO (newIORef nullPtr) +wakeupIOManager :: IO () wakeupIOManager = do _hdl <- readIORef stick c_sendIOManagerEvent io_MANAGER_WAKEUP @@ -994,7 +999,8 @@ getDelay now all@(d : rest) type HANDLE = Ptr () type DWORD = Word32 -iNFINITE = 0xFFFFFFFF :: DWORD -- urgh +iNFINITE :: DWORD +iNFINITE = 0xFFFFFFFF -- urgh foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c) c_getIOManagerEvent :: IO HANDLE diff --git a/GHC/ConsoleHandler.hs b/GHC/ConsoleHandler.hs index aaf01c3..cabaa53 100644 --- a/GHC/ConsoleHandler.hs +++ b/GHC/ConsoleHandler.hs @@ -37,7 +37,6 @@ import Foreign.C import GHC.IOBase import GHC.Conc import GHC.Handle -import Data.Typeable import Control.Concurrent.MVar data Handler @@ -84,6 +83,7 @@ installHandler handler STG_SIG_DFL -> return Default STG_SIG_IGN -> return Ignore STG_SIG_HAN -> return (Catch old_h) + _ -> error "installHandler: Bad threaded rc value" return (new_h, prev_handler) | otherwise = @@ -105,6 +105,7 @@ installHandler handler -- stable pointer is no longer in use, free it. freeStablePtr osptr return (Catch (\ ev -> oldh (fromConsoleEvent ev))) + _ -> error "installHandler: Bad non-threaded rc value" where fromConsoleEvent ev = case ev of diff --git a/GHC/Handle.hs b/GHC/Handle.hs index 2876260..97b7f88 100644 --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -1,4 +1,6 @@ {-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-} +{-# OPTIONS_GHC -fno-warn-unused-matches #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_HADDOCK hide #-} #undef DEBUG_DUMP @@ -685,6 +687,8 @@ readRawBufferPtrNoBlock :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> I readRawBufferPtrNoBlock = readRawBufferPtr -- Async versions of the read/write primitives, for the non-threaded RTS +asyncReadRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt + -> IO CInt asyncReadRawBuffer loc fd is_stream buf off len = do (l, rc) <- asyncReadBA (fromIntegral fd) (if is_stream then 1 else 0) (fromIntegral len) off buf @@ -693,6 +697,8 @@ asyncReadRawBuffer loc fd is_stream buf off len = do ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) +asyncReadRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt + -> IO CInt asyncReadRawBufferPtr loc fd is_stream buf off len = do (l, rc) <- asyncRead (fromIntegral fd) (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off) @@ -701,6 +707,8 @@ asyncReadRawBufferPtr loc fd is_stream buf off len = do ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) +asyncWriteRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt + -> IO CInt asyncWriteRawBuffer loc fd is_stream buf off len = do (l, rc) <- asyncWriteBA (fromIntegral fd) (if is_stream then 1 else 0) (fromIntegral len) off buf @@ -709,6 +717,8 @@ asyncWriteRawBuffer loc fd is_stream buf off len = do ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing) else return (fromIntegral l) +asyncWriteRawBufferPtr :: String -> FD -> Bool -> CString -> Int -> CInt + -> IO CInt asyncWriteRawBufferPtr loc fd is_stream buf off len = do (l, rc) <- asyncWrite (fromIntegral fd) (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off) @@ -719,6 +729,8 @@ asyncWriteRawBufferPtr loc fd is_stream buf off len = do -- Blocking versions of the read/write primitives, for the threaded RTS +blockingReadRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt + -> IO CInt blockingReadRawBuffer loc fd True buf off len = throwErrnoIfMinus1Retry loc $ safe_recv_rawBuffer fd buf off len @@ -726,6 +738,8 @@ blockingReadRawBuffer loc fd False buf off len = throwErrnoIfMinus1Retry loc $ safe_read_rawBuffer fd buf off len +blockingReadRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt + -> IO CInt blockingReadRawBufferPtr loc fd True buf off len = throwErrnoIfMinus1Retry loc $ safe_recv_off fd buf off len @@ -733,6 +747,8 @@ blockingReadRawBufferPtr loc fd False buf off len = throwErrnoIfMinus1Retry loc $ safe_read_off fd buf off len +blockingWriteRawBuffer :: String -> CInt -> Bool -> RawBuffer -> Int -> CInt + -> IO CInt blockingWriteRawBuffer loc fd True buf off len = throwErrnoIfMinus1Retry loc $ safe_send_rawBuffer fd buf off len @@ -740,6 +756,8 @@ blockingWriteRawBuffer loc fd False buf off len = throwErrnoIfMinus1Retry loc $ safe_write_rawBuffer fd buf off len +blockingWriteRawBufferPtr :: String -> CInt -> Bool -> CString -> Int -> CInt + -> IO CInt blockingWriteRawBufferPtr loc fd True buf off len = throwErrnoIfMinus1Retry loc $ safe_send_off fd buf off len @@ -1056,9 +1074,11 @@ mkFileHandle fd is_stream filepath ha_type binary = do -- turn off buffering. We don't correctly handle the case of switching -- from read mode to write mode on a buffered text-mode handle, see bug -- \#679. - bmode <- case ha_type of - ReadWriteHandle | not binary -> return NoBuffering - _other -> return bmode + bmode2 <- case ha_type of + ReadWriteHandle | not binary -> return NoBuffering + _other -> return bmode +#else + let bmode2 = bmode #endif spares <- newIORef BufferListNil @@ -1067,7 +1087,7 @@ mkFileHandle fd is_stream filepath ha_type binary = do haType = ha_type, haIsBin = binary, haIsStream = is_stream, - haBufferMode = bmode, + haBufferMode = bmode2, haBuffer = buf, haBuffers = spares, haOtherSide = Nothing diff --git a/GHC/IO.hs b/GHC/IO.hs index f0d2fc1..e73b592 100644 --- a/GHC/IO.hs +++ b/GHC/IO.hs @@ -35,7 +35,9 @@ import Foreign.C import System.IO.Error import Data.Maybe import Control.Monad +#ifndef mingw32_HOST_OS import System.Posix.Internals +#endif import GHC.Enum import GHC.Base diff --git a/GHC/TopHandler.lhs b/GHC/TopHandler.lhs index b5a7411..dffba02 100644 --- a/GHC/TopHandler.lhs +++ b/GHC/TopHandler.lhs @@ -1,5 +1,6 @@ \begin{code} {-# OPTIONS_GHC -XNoImplicitPrelude #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs index 66ca50c..1a9f845 100644 --- a/System/Posix/Internals.hs +++ b/System/Posix/Internals.hs @@ -25,7 +25,9 @@ module System.Posix.Internals where #include "HsBaseConfig.h" +#if ! (defined(mingw32_HOST_OS) || defined(__MINGW32__)) import Control.Monad +#endif import System.Posix.Types import Foreign @@ -140,12 +142,13 @@ foreign import stdcall unsafe "HsBase.h closesocket" #endif fdGetMode :: FD -> IO IOMode -fdGetMode fd = do #if defined(mingw32_HOST_OS) || defined(__MINGW32__) +fdGetMode _ = do -- We don't have a way of finding out which flags are set on FDs -- on Windows, so make a handle that thinks that anything goes. let flags = o_RDWR #else +fdGetMode fd = do flags <- throwErrnoIfMinus1Retry "fdGetMode" (c_fcntl_read fd const_f_getfl) #endif @@ -261,6 +264,7 @@ setCooked fd cooked = do then ioError (ioe_unk_error "setCooked" "failed to set buffering") else return () +ioe_unk_error :: String -> String -> IOException ioe_unk_error loc msg = IOError Nothing OtherError loc msg Nothing @@ -294,8 +298,8 @@ foreign import ccall unsafe "consUtils.h get_console_echo__" -- --------------------------------------------------------------------------- -- Turning on non-blocking for a file descriptor -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) setNonBlockingFD :: FD -> IO () +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) setNonBlockingFD fd = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" (c_fcntl_read fd const_f_getfl) @@ -308,7 +312,7 @@ setNonBlockingFD fd = do #else -- bogus defns for win32 -setNonBlockingFD fd = return () +setNonBlockingFD _ = return () #endif @@ -505,11 +509,10 @@ foreign import ccall unsafe "HsBase.h __hscore_poke_lflag" poke_c_lflag :: Ptr C foreign import ccall unsafe "HsBase.h __hscore_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) #endif -#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) -foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt s_issock :: CMode -> Bool +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) s_issock cmode = c_s_issock cmode /= 0 +foreign import ccall unsafe "HsBase.h __hscore_s_issock" c_s_issock :: CMode -> CInt #else -s_issock :: CMode -> Bool -s_issock cmode = False +s_issock _ = False #endif