fdReady: Use C99 bools / CBool in signature

Reviewers: bgamari, Phyx, austin, hvr, simonmar

Reviewed By: bgamari

Subscribers: syd, rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D4041

4 files changed, 13 insertions, 12 deletions

diff --git a/libraries/base/Control/Concurrent.hs b/libraries/base/Control/Concurrent.hs
index 094639988b..bd222e2b1e 100644
--- a/libraries/base/Control/Concurrent.hs
+++ b/libraries/base/Control/Concurrent.hs
@@ -407,7 +407,7 @@ threadWaitRead fd
   -- fdReady does the right thing, but we have to call it in a
   -- separate thread, otherwise threadWaitRead won't be interruptible,
   -- and this only works with -threaded.
-  | threaded  = withThread (waitFd fd 0)
+  | threaded  = withThread (waitFd fd False)
   | otherwise = case fd of
                   0 -> do _ <- hWaitForInput stdin (-1)
                           return ()
@@ -428,7 +428,7 @@ threadWaitRead fd
 threadWaitWrite :: Fd -> IO ()
 threadWaitWrite fd
 #if defined(mingw32_HOST_OS)
-  | threaded  = withThread (waitFd fd 1)
+  | threaded  = withThread (waitFd fd True)
   | otherwise = errorWithoutStackTrace "threadWaitWrite requires -threaded on Windows"
 #else
   = GHC.Conc.threadWaitWrite fd
@@ -444,7 +444,7 @@ threadWaitReadSTM :: Fd -> IO (STM (), IO ())
 threadWaitReadSTM fd
 #if defined(mingw32_HOST_OS)
   | threaded = do v <- newTVarIO Nothing
-                  mask_ $ void $ forkIO $ do result <- try (waitFd fd 0)
+                  mask_ $ void $ forkIO $ do result <- try (waitFd fd False)
                                              atomically (writeTVar v $ Just result)
                   let waitAction = do result <- readTVar v
                                       case result of
@@ -468,7 +468,7 @@ threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
 threadWaitWriteSTM fd
 #if defined(mingw32_HOST_OS)
   | threaded = do v <- newTVarIO Nothing
-                  mask_ $ void $ forkIO $ do result <- try (waitFd fd 1)
+                  mask_ $ void $ forkIO $ do result <- try (waitFd fd True)
                                              atomically (writeTVar v $ Just result)
                   let waitAction = do result <- readTVar v
                                       case result of
@@ -494,13 +494,13 @@ withThread io = do
     Right a -> return a
     Left e  -> throwIO (e :: IOException)
 
-waitFd :: Fd -> CInt -> IO ()
+waitFd :: Fd -> Bool -> IO ()
 waitFd fd write = do
    throwErrnoIfMinus1_ "fdReady" $
-        fdReady (fromIntegral fd) write (-1) 0
+        fdReady (fromIntegral fd) (if write then 1 else 0) (-1) 0
 
 foreign import ccall safe "fdReady"
-  fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt
+  fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt
 #endif
 
 -- ---------------------------------------------------------------------------
diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs
index 4a4f063219..bb188a9b9b 100644
--- a/libraries/base/GHC/IO/FD.hs
+++ b/libraries/base/GHC/IO/FD.hs
@@ -401,7 +401,7 @@ ready fd write msecs = do
   return (toEnum (fromIntegral r))
 
 foreign import ccall safe "fdReady"
-  fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt
+  fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt
 
 -- ---------------------------------------------------------------------------
 -- Terminal-related stuff
@@ -562,7 +562,7 @@ isNonBlocking :: FD -> Bool
 isNonBlocking fd = fdIsNonBlocking fd /= 0
 
 foreign import ccall unsafe "fdReady"
-  unsafe_fdReady :: CInt -> CInt -> Int64 -> CInt -> IO CInt
+  unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt
 
 #else /* mingw32_HOST_OS.... */
 
diff --git a/libraries/base/cbits/inputReady.c b/libraries/base/cbits/inputReady.c
index a3024bf114..9b1bb9eaf7 100644
--- a/libraries/base/cbits/inputReady.c
+++ b/libraries/base/cbits/inputReady.c
@@ -134,7 +134,7 @@ compute_WaitForSingleObject_timeout(bool infinite, Time remaining)
  * On error, sets `errno`.
  */
 int
-fdReady(int fd, int write, int64_t msecs, int isSock)
+fdReady(int fd, bool write, int64_t msecs, bool isSock)
 {
     bool infinite = msecs < 0;
 
diff --git a/libraries/base/include/HsBase.h b/libraries/base/include/HsBase.h
index 748e3577ce..13640c590e 100644
--- a/libraries/base/include/HsBase.h
+++ b/libraries/base/include/HsBase.h
@@ -24,6 +24,7 @@
 
 #include "HsFFI.h"
 
+#include <stdbool.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <math.h>
@@ -152,7 +153,7 @@ extern HsWord64 getMonotonicUSec(void);
 #endif
 
 /* in inputReady.c */
-extern int fdReady(int fd, int write, int64_t msecs, int isSock);
+extern int fdReady(int fd, bool write, int64_t msecs, bool isSock);
 
 /* -----------------------------------------------------------------------------
    INLINE functions.
@@ -288,7 +289,7 @@ __hscore_ftruncate( int fd, off_t where )
   return _chsize(fd,where);
 #else
 // ToDo: we should use _chsize_s() on Windows which allows a 64-bit
-// offset, but it doesn't seem to be available from mingw at this time 
+// offset, but it doesn't seem to be available from mingw at this time
 // --SDM (01/2008)
 #error at least ftruncate or _chsize functions are required to build
 #endif