From: Ian Lynagh Date: Mon, 19 Feb 2007 23:38:54 +0000 (+0000) Subject: Consistently use CInt rather than Int for FDs X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5be79ed580000c45c15ac3ba50dcb48d8fcaed1e;p=haskell-directory.git Consistently use CInt rather than Int for FDs --- diff --git a/Data/Typeable.hs-boot b/Data/Typeable.hs-boot index 4250e56..5a2989c 100644 --- a/Data/Typeable.hs-boot +++ b/Data/Typeable.hs-boot @@ -1,3 +1,16 @@ + {-# OPTIONS -fno-implicit-prelude #-} + module Data.Typeable where + +import GHC.Base + data TypeRep +data TyCon + +mkTyCon :: String -> TyCon +mkTyConApp :: TyCon -> [TypeRep] -> TypeRep + +class Typeable a where + typeOf :: a -> TypeRep + diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs index 7e8c5a3..04a96ab 100644 --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -66,11 +66,11 @@ module Foreign.C.Types #ifndef __NHC__ -import Foreign.Storable +import {-# SOURCE #-} Foreign.Storable import Data.Bits ( Bits(..) ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word64 ) -import Data.Typeable +import {-# SOURCE #-} Data.Typeable #ifdef __GLASGOW_HASKELL__ import GHC.Base diff --git a/Foreign/Storable.hs-boot b/Foreign/Storable.hs-boot new file mode 100644 index 0000000..12d256c --- /dev/null +++ b/Foreign/Storable.hs-boot @@ -0,0 +1,23 @@ + +{-# OPTIONS -fno-implicit-prelude #-} + +module Foreign.Storable where + +import GHC.Float +import GHC.Int +import GHC.Num +import GHC.Word + +class Storable a + +instance Storable Int8 +instance Storable Int16 +instance Storable Int32 +instance Storable Int64 +instance Storable Word8 +instance Storable Word16 +instance Storable Word32 +instance Storable Word64 +instance Storable Float +instance Storable Double + diff --git a/GHC/Handle.hs b/GHC/Handle.hs index e0b755f..3b7a3dc 100644 --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -453,7 +453,7 @@ flushReadBuffer fd buf puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n") # endif throwErrnoIfMinus1Retry "flushReadBuffer" - (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR) + (c_lseek fd (fromIntegral off) sEEK_CUR) return buf{ bufWPtr=0, bufRPtr=0 } flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer @@ -466,7 +466,7 @@ flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = if bytes == 0 then return (buf{ bufRPtr=0, bufWPtr=0 }) else do - res <- writeRawBuffer "flushWriteBuffer" (fromIntegral fd) is_stream b + res <- writeRawBuffer "flushWriteBuffer" fd is_stream b (fromIntegral r) (fromIntegral bytes) let res' = fromIntegral res if res' < bytes @@ -549,13 +549,13 @@ readRawBufferPtr loc fd is_stream buf off len = writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt writeRawBuffer loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc - (write_rawBuffer (fromIntegral fd) buf off len) + (write_rawBuffer fd buf off len) (threadWaitWrite (fromIntegral fd)) writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt writeRawBufferPtr loc fd is_stream buf off len = throwErrnoIfMinus1RetryMayBlock loc - (write_off (fromIntegral fd) buf off len) + (write_off fd buf off len) (threadWaitWrite (fromIntegral fd)) foreign import ccall unsafe "__hscore_PrelHandle_read" @@ -648,17 +648,17 @@ blockingReadRawBufferPtr loc fd False buf off len = blockingWriteRawBuffer loc fd True buf off len = throwErrnoIfMinus1Retry loc $ - send_rawBuffer (fromIntegral fd) buf off len + send_rawBuffer fd buf off len blockingWriteRawBuffer loc fd False buf off len = throwErrnoIfMinus1Retry loc $ - write_rawBuffer (fromIntegral fd) buf off len + write_rawBuffer fd buf off len blockingWriteRawBufferPtr loc fd True buf off len = throwErrnoIfMinus1Retry loc $ - send_off (fromIntegral fd) buf off len + send_off fd buf off len blockingWriteRawBufferPtr loc fd False buf off len = throwErrnoIfMinus1Retry loc $ - write_off (fromIntegral fd) buf off len + write_off fd buf off len -- NOTE: "safe" versions of the read/write calls for use by the threaded RTS. -- These calls may block, but that's ok. @@ -809,14 +809,13 @@ openFile' filepath mode binary = -- directories. However, the man pages I've read say that open() -- always returns EISDIR if the file is a directory and was opened -- for writing, so I think we're ok with a single open() here... - fd <- fromIntegral `liftM` - throwErrnoIfMinus1Retry "openFile" + fd <- throwErrnoIfMinus1Retry "openFile" (c_open f (fromIntegral oflags) 0o666) fd_type <- fdType fd h <- openFd fd (Just fd_type) False filepath mode binary - `catchException` \e -> do c_close (fromIntegral fd); throw e + `catchException` \e -> do c_close fd; throw e -- NB. don't forget to close the FD if openFd fails, otherwise -- this FD leaks. -- ASSERT: if we just created the file, then openFd won't fail @@ -829,7 +828,7 @@ openFile' filepath mode binary = -- like /dev/null. if mode == WriteMode && fd_type == RegularFile then throwErrnoIf (/=0) "openFile" - (c_ftruncate (fromIntegral fd) 0) + (c_ftruncate fd 0) else return 0 #endif return h @@ -873,8 +872,8 @@ openTempFile' loc tmp_dir template binary = do then findTempName (x+1) else ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) else do - h <- openFd (fromIntegral fd) Nothing False filepath ReadWriteMode True - `catchException` \e -> do c_close (fromIntegral fd); throw e + h <- openFd fd Nothing False filepath ReadWriteMode True + `catchException` \e -> do c_close fd; throw e return (filepath, h) where filename = prefix ++ show x ++ suffix @@ -918,7 +917,7 @@ openFd fd mb_fd_type is_socket filepath mode binary = do -- regular files need to be locked RegularFile -> do #ifndef mingw32_HOST_OS - r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-} + r <- lockFile fd (fromBool write) 1{-exclusive-} when (r == -1) $ ioException (IOError Nothing ResourceBusy "openFile" "file is locked" Nothing) @@ -1061,7 +1060,6 @@ hClose_help handle_ = hClose_handle_ handle_ = do let fd = haFD handle_ - c_fd = fromIntegral fd -- close the file descriptor, but not when this is the read -- side of a duplex handle. @@ -1069,9 +1067,9 @@ hClose_handle_ handle_ = do Nothing -> throwErrnoIfMinus1Retry_ "hClose" #ifdef mingw32_HOST_OS - (closeFd (haIsStream handle_) c_fd) + (closeFd (haIsStream handle_) fd) #else - (c_close c_fd) + (c_close fd) #endif Just _ -> return () @@ -1080,7 +1078,7 @@ hClose_handle_ handle_ = do #ifndef mingw32_HOST_OS -- unlock it - unlockFile c_fd + unlockFile fd #endif -- we must set the fd to -1, because the finalizer is going @@ -1119,7 +1117,7 @@ hSetFileSize handle size = SemiClosedHandle -> ioe_closedHandle _ -> do flushWriteBufferOnly handle_ throwErrnoIf (/=0) "hSetFileSize" - (c_ftruncate (fromIntegral (haFD handle_)) (fromIntegral size)) + (c_ftruncate (haFD handle_) (fromIntegral size)) return () -- --------------------------------------------------------------------------- @@ -1358,7 +1356,7 @@ hSeek handle mode offset = let do_seek = throwErrnoIfMinus1Retry_ "hSeek" - (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence) + (c_lseek (haFD handle_) (fromIntegral offset) whence) whence :: CInt whence = case mode of @@ -1391,7 +1389,7 @@ hTell handle = -- current buffer size. Just flush instead. flushBuffer handle_ #endif - let fd = fromIntegral (haFD handle_) + let fd = haFD handle_ posn <- fromIntegral `liftM` throwErrnoIfMinus1Retry "hGetPosn" (c_lseek fd 0 sEEK_CUR) @@ -1530,7 +1528,7 @@ hSetBinaryMode :: Handle -> Bool -> IO () hSetBinaryMode handle bin = withAllHandles__ "hSetBinaryMode" handle $ \ handle_ -> do throwErrnoIfMinus1_ "hSetBinaryMode" - (setmode (fromIntegral (haFD handle_)) bin) + (setmode (haFD handle_) bin) return handle_{haIsBin=bin} foreign import ccall unsafe "__hscore_setmode" @@ -1560,22 +1558,24 @@ dupHandle other_side h_ = do -- flush the buffer first, so we don't have to copy its contents flushBuffer h_ new_fd <- throwErrnoIfMinus1 "dupHandle" $ - c_dup (fromIntegral (haFD h_)) + c_dup (haFD h_) dupHandle_ other_side h_ new_fd dupHandleTo other_side hto_ h_ = do flushBuffer h_ -- Windows' dup2 does not return the new descriptor, unlike Unix throwErrnoIfMinus1 "dupHandleTo" $ - c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_)) + c_dup2 (haFD h_) (haFD hto_) dupHandle_ other_side h_ (haFD hto_) +dupHandle_ :: Maybe (MVar Handle__) -> Handle__ -> FD + -> IO (Handle__, Handle__) dupHandle_ other_side h_ new_fd = do buffer <- allocateBuffer dEFAULT_BUFFER_SIZE (initBufferState (haType h_)) ioref <- newIORef buffer ioref_buffers <- newIORef BufferListNil - let new_handle_ = h_{ haFD = fromIntegral new_fd, + let new_handle_ = h_{ haFD = new_fd, haBuffer = ioref, haBuffers = ioref_buffers, haOtherSide = other_side } diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs index 3442677..e149ae5 100644 --- a/GHC/IOBase.lhs +++ b/GHC/IOBase.lhs @@ -53,6 +53,7 @@ import Data.Maybe ( Maybe(..) ) import GHC.Show import GHC.List import GHC.Read +import Foreign.C.Types (CInt) #ifndef __HADDOCK__ import {-# SOURCE #-} GHC.Dynamic @@ -342,7 +343,7 @@ instance Eq Handle where (DuplexHandle _ h1 _) == (DuplexHandle _ h2 _) = h1 == h2 _ == _ = False -type FD = Int -- XXX ToDo: should be CInt +type FD = CInt data Handle__ = Handle__ { diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs index 711a880..a39c66d 100644 --- a/System/Posix/Internals.hs +++ b/System/Posix/Internals.hs @@ -72,11 +72,11 @@ type FD = Int -- --------------------------------------------------------------------------- -- stat()-related stuff -fdFileSize :: Int -> IO Integer +fdFileSize :: FD -> IO Integer fdFileSize fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry "fileSize" $ - c_fstat (fromIntegral fd) p_stat + c_fstat fd p_stat c_mode <- st_mode p_stat :: IO CMode if not (s_isreg c_mode) then return (-1) @@ -97,11 +97,11 @@ fileType file = -- NOTE: On Win32 platforms, this will only work with file descriptors -- referring to file handles. i.e., it'll fail for socket FDs. -fdType :: Int -> IO FDType +fdType :: FD -> IO FDType fdType fd = allocaBytes sizeof_stat $ \ p_stat -> do throwErrnoIfMinus1Retry "fdType" $ - c_fstat (fromIntegral fd) p_stat + c_fstat fd p_stat statGetType p_stat statGetType p_stat = do @@ -129,17 +129,17 @@ foreign import stdcall unsafe "HsBase.h closesocket" c_closesocket :: CInt -> IO CInt #endif -fdGetMode :: Int -> IO IOMode +fdGetMode :: FD -> IO IOMode fdGetMode fd = do #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -- XXX: this code is *BROKEN*, _setmode only deals with O_TEXT/O_BINARY flags1 <- throwErrnoIfMinus1Retry "fdGetMode" - (c__setmode (fromIntegral fd) (fromIntegral o_WRONLY)) + (c__setmode fd (fromIntegral o_WRONLY)) flags <- throwErrnoIfMinus1Retry "fdGetMode" - (c__setmode (fromIntegral fd) (fromIntegral flags1)) + (c__setmode fd (fromIntegral flags1)) #else flags <- throwErrnoIfMinus1Retry "fdGetMode" - (c_fcntl_read (fromIntegral fd) const_f_getfl) + (c_fcntl_read fd const_f_getfl) #endif let wH = (flags .&. o_WRONLY) /= 0 @@ -157,12 +157,12 @@ fdGetMode fd = do -- --------------------------------------------------------------------------- -- Terminal-related stuff -fdIsTTY :: Int -> IO Bool -fdIsTTY fd = c_isatty (fromIntegral fd) >>= return.toBool +fdIsTTY :: FD -> IO Bool +fdIsTTY fd = c_isatty fd >>= return.toBool #if defined(HTYPE_TCFLAG_T) -setEcho :: Int -> Bool -> IO () +setEcho :: FD -> Bool -> IO () setEcho fd on = do tcSetAttr fd $ \ p_tios -> do c_lflag <- c_lflag p_tios :: IO CTcflag @@ -171,13 +171,13 @@ setEcho fd on = do | otherwise = c_lflag .&. complement (fromIntegral const_echo) poke_c_lflag p_tios (new_c_lflag :: CTcflag) -getEcho :: Int -> IO Bool +getEcho :: FD -> IO Bool getEcho fd = do tcSetAttr fd $ \ p_tios -> do c_lflag <- c_lflag p_tios :: IO CTcflag return ((c_lflag .&. fromIntegral const_echo) /= 0) -setCooked :: Int -> Bool -> IO () +setCooked :: FD -> Bool -> IO () setCooked fd cooked = tcSetAttr fd $ \ p_tios -> do @@ -199,7 +199,7 @@ tcSetAttr :: FD -> (Ptr CTermios -> IO a) -> IO a tcSetAttr fd fun = do allocaBytes sizeof_termios $ \p_tios -> do throwErrnoIfMinus1Retry "tcSetAttr" - (c_tcgetattr (fromIntegral fd) p_tios) + (c_tcgetattr fd p_tios) #ifdef __GLASGOW_HASKELL__ -- Save a copy of termios, if this is a standard file descriptor. @@ -224,16 +224,16 @@ tcSetAttr fd fun = do c_sigprocmask const_sig_block p_sigset p_old_sigset r <- fun p_tios -- do the business throwErrnoIfMinus1Retry_ "tcSetAttr" $ - c_tcsetattr (fromIntegral fd) const_tcsanow p_tios + c_tcsetattr fd const_tcsanow p_tios c_sigprocmask const_sig_setmask p_old_sigset nullPtr return r #ifdef __GLASGOW_HASKELL__ foreign import ccall unsafe "HsBase.h __hscore_get_saved_termios" - get_saved_termios :: Int -> IO (Ptr CTermios) + get_saved_termios :: CInt -> IO (Ptr CTermios) foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios" - set_saved_termios :: Int -> (Ptr CTermios) -> IO () + set_saved_termios :: CInt -> (Ptr CTermios) -> IO () #endif #else @@ -246,9 +246,9 @@ foreign import ccall unsafe "HsBase.h __hscore_set_saved_termios" -- report that character until another character is input..odd.) This -- latter feature doesn't sit too well with IO actions like IO.hGetLine.. -- consider yourself warned. -setCooked :: Int -> Bool -> IO () +setCooked :: FD -> Bool -> IO () setCooked fd cooked = do - x <- set_console_buffering (fromIntegral fd) (if cooked then 1 else 0) + x <- set_console_buffering fd (if cooked then 1 else 0) if (x /= 0) then ioError (ioe_unk_error "setCooked" "failed to set buffering") else return () @@ -258,16 +258,16 @@ ioe_unk_error loc msg -- Note: echoing goes hand in hand with enabling 'line input' / raw-ness -- for Win32 consoles, hence setEcho ends up being the inverse of setCooked. -setEcho :: Int -> Bool -> IO () +setEcho :: FD -> Bool -> IO () setEcho fd on = do - x <- set_console_echo (fromIntegral fd) (if on then 1 else 0) + x <- set_console_echo fd (if on then 1 else 0) if (x /= 0) then ioError (ioe_unk_error "setEcho" "failed to set echoing") else return () -getEcho :: Int -> IO Bool +getEcho :: FD -> IO Bool getEcho fd = do - r <- get_console_echo (fromIntegral fd) + r <- get_console_echo fd if (r == (-1)) then ioError (ioe_unk_error "getEcho" "failed to get echoing") else return (r == 1) @@ -290,12 +290,12 @@ foreign import ccall unsafe "consUtils.h get_console_echo__" setNonBlockingFD fd = do flags <- throwErrnoIfMinus1Retry "setNonBlockingFD" - (c_fcntl_read (fromIntegral fd) const_f_getfl) + (c_fcntl_read fd const_f_getfl) -- An error when setting O_NONBLOCK isn't fatal: on some systems -- there are certain file handles on which this will fail (eg. /dev/null -- on FreeBSD) so we throw away the return code from fcntl_write. unless (testBit flags (fromIntegral o_NONBLOCK)) $ do - c_fcntl_write (fromIntegral fd) const_f_setfl (flags .|. o_NONBLOCK) + c_fcntl_write fd const_f_setfl (flags .|. o_NONBLOCK) return () #else