diff options
Diffstat (limited to 'libraries')
-rw-r--r-- | libraries/base/GHC/Conc.hs | 2 | ||||
-rw-r--r-- | libraries/base/GHC/Conc/IO.hs | 87 | ||||
-rw-r--r-- | libraries/base/GHC/IO/FD.hs | 7 | ||||
-rw-r--r-- | libraries/base/GHC/IO/Types.hs | 41 | ||||
-rw-r--r-- | libraries/base/base.cabal | 1 |
5 files changed, 42 insertions, 96 deletions
diff --git a/libraries/base/GHC/Conc.hs b/libraries/base/GHC/Conc.hs index 962b29a4df..15397422a5 100644 --- a/libraries/base/GHC/Conc.hs +++ b/libraries/base/GHC/Conc.hs @@ -59,7 +59,7 @@ module GHC.Conc , threadWaitWrite , threadWaitReadSTM , threadWaitWriteSTM - , closeWith + , closeFdWith -- * Allocation counter and limit , setAllocationCounter diff --git a/libraries/base/GHC/Conc/IO.hs b/libraries/base/GHC/Conc/IO.hs index 4c1d8c6d23..385a9fc263 100644 --- a/libraries/base/GHC/Conc/IO.hs +++ b/libraries/base/GHC/Conc/IO.hs @@ -38,7 +38,7 @@ module GHC.Conc.IO , threadWaitWrite , threadWaitReadSTM , threadWaitWriteSTM - , closeWith + , closeFdWith #if defined(mingw32_HOST_OS) , asyncRead @@ -58,6 +58,7 @@ import Foreign import GHC.Base import GHC.Conc.Sync as Sync import GHC.Real ( fromIntegral ) +import System.Posix.Types #if defined(mingw32_HOST_OS) import qualified GHC.Conc.Windows as Windows @@ -68,8 +69,6 @@ import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA, #else import qualified GHC.Event.Thread as Event #endif -import GHC.IO.Types (BHandle) -import qualified GHC.IO.Types as Types ensureIOManagerIsRunning :: IO () #if !defined(mingw32_HOST_OS) @@ -97,56 +96,50 @@ ioManagerCapabilitiesChanged = return () #endif -- | Block the current thread until data is available to read on the --- given handle or file descriptor (GHC only). +-- given file descriptor (GHC only). -- --- This will throw an 'Prelude.IOError' if the handle or file descriptor was closed --- while this thread was blocked. To safely close a handle or file descriptor +-- This will throw an 'Prelude.IOError' if the file descriptor was closed +-- while this thread was blocked. To safely close a file descriptor -- that has been used with 'threadWaitRead', use 'closeFdWith'. -{-# SPECIALIZE threadWaitRead :: Types.IntPtr -> IO () #-} -{-# SPECIALIZE threadWaitRead :: Types.Fd -> IO () #-} -threadWaitRead :: BHandle a => a -> IO () -threadWaitRead bh +threadWaitRead :: Fd -> IO () +threadWaitRead fd #if !defined(mingw32_HOST_OS) - | threaded = Event.threadWaitRead (toFD bh) + | threaded = Event.threadWaitRead fd #endif | otherwise = IO $ \s -> - case fromIntegral bh of { I# bh# -> - case waitRead# bh# s of { s' -> (# s', () #) + case fromIntegral fd of { I# fd# -> + case waitRead# fd# s of { s' -> (# s', () #) }} -- | Block the current thread until data can be written to the --- given handle or file descriptor (GHC only). +-- given file descriptor (GHC only). -- --- This will throw an 'Prelude.IOError' if the handle or file descriptor was closed --- while this thread was blocked. To safely close a handle or file descriptor +-- This will throw an 'Prelude.IOError' if the file descriptor was closed +-- while this thread was blocked. To safely close a file descriptor -- that has been used with 'threadWaitWrite', use 'closeFdWith'. -{-# SPECIALIZE threadWaitWrite :: Types.IntPtr -> IO () #-} -{-# SPECIALIZE threadWaitWrite :: Types.Fd -> IO () #-} -threadWaitWrite :: BHandle a => a -> IO () -threadWaitWrite bh +threadWaitWrite :: Fd -> IO () +threadWaitWrite fd #if !defined(mingw32_HOST_OS) - | threaded = Event.threadWaitWrite (toFD bh) + | threaded = Event.threadWaitWrite fd #endif | otherwise = IO $ \s -> - case fromIntegral bh of { I# bh# -> - case waitWrite# bh# s of { s' -> (# s', () #) + case fromIntegral fd of { I# fd# -> + case waitWrite# fd# s of { s' -> (# s', () #) }} -- | Returns an STM action that can be used to wait for data --- to read from a handle or file descriptor. The second returned value +-- to read from a file descriptor. The second returned value -- is an IO action that can be used to deregister interest --- in the handle or file descriptor. -{-# SPECIALIZE threadWaitReadSTM :: Types.IntPtr -> IO (Sync.STM (), IO ()) #-} -{-# SPECIALIZE threadWaitReadSTM :: Types.Fd -> IO (Sync.STM (), IO ()) #-} -threadWaitReadSTM :: BHandle a => a -> IO (Sync.STM (), IO ()) -threadWaitReadSTM bh +-- in the file descriptor. +threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ()) +threadWaitReadSTM fd #if !defined(mingw32_HOST_OS) - | threaded = Event.threadWaitReadSTM (toFD bh) + | threaded = Event.threadWaitReadSTM fd #endif | otherwise = do m <- Sync.newTVarIO False t <- Sync.forkIO $ do - threadWaitRead bh + threadWaitRead fd Sync.atomically $ Sync.writeTVar m True let waitAction = do b <- Sync.readTVar m if b then return () else retry @@ -154,44 +147,40 @@ threadWaitReadSTM bh return (waitAction, killAction) -- | Returns an STM action that can be used to wait until data --- can be written to a handle or file descriptor. The second returned value +-- can be written to a file descriptor. The second returned value -- is an IO action that can be used to deregister interest --- in the handle or file descriptor. -{-# SPECIALIZE threadWaitWriteSTM :: Types.IntPtr -> IO (Sync.STM (), IO ()) #-} -{-# SPECIALIZE threadWaitWriteSTM :: Types.Fd -> IO (Sync.STM (), IO ()) #-} -threadWaitWriteSTM :: BHandle a => a -> IO (Sync.STM (), IO ()) -threadWaitWriteSTM bh +-- in the file descriptor. +threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ()) +threadWaitWriteSTM fd #if !defined(mingw32_HOST_OS) - | threaded = Event.threadWaitWriteSTM (toFD bh) + | threaded = Event.threadWaitWriteSTM fd #endif | otherwise = do m <- Sync.newTVarIO False t <- Sync.forkIO $ do - threadWaitWrite bh + threadWaitWrite fd Sync.atomically $ Sync.writeTVar m True let waitAction = do b <- Sync.readTVar m if b then return () else retry let killAction = Sync.killThread t return (waitAction, killAction) --- | Close a handle or file descriptor in a concurrency-safe way (GHC only). If +-- | Close a file descriptor in a concurrency-safe way (GHC only). If -- you are using 'threadWaitRead' or 'threadWaitWrite' to perform -- blocking I\/O, you /must/ use this function to close file -- descriptors, or blocked threads may not be woken. -- --- Any threads that are blocked on the handle or file descriptor via +-- Any threads that are blocked on the file descriptor via -- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having -- IO exceptions thrown. -{-# SPECIALIZE closeWith :: (Types.IntPtr ->IO ()) -> Types.IntPtr -> IO () #-} -{-# SPECIALIZE closeWith :: (Types.Fd ->IO ()) -> Types.Fd -> IO () #-} -closeWith :: BHandle a => (a -> IO ()) -- ^ Low-level action that performs the real close. - -> a -- ^ handle or file descriptor to close. - -> IO () -closeWith close bh +closeFdWith :: (Fd -> IO ()) -- ^ Low-level action that performs the real close. + -> Fd -- ^ File descriptor to close. + -> IO () +closeFdWith close fd #if !defined(mingw32_HOST_OS) - | threaded = Event.closeFdWith close (toFD bh) + | threaded = Event.closeFdWith close fd #endif - | otherwise = close bh + | otherwise = close fd -- | Suspends the current thread for a given number of microseconds -- (GHC only). diff --git a/libraries/base/GHC/IO/FD.hs b/libraries/base/GHC/IO/FD.hs index 2cb71b35dc..9e1a8cf08e 100644 --- a/libraries/base/GHC/IO/FD.hs +++ b/libraries/base/GHC/IO/FD.hs @@ -35,7 +35,6 @@ import GHC.Show import GHC.Enum import GHC.IO -import GHC.IO.Types import GHC.IO.IOMode import GHC.IO.Buffer import GHC.IO.BufferedIO @@ -332,17 +331,17 @@ close fd = throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $ #if defined(mingw32_HOST_OS) if fdIsSocket fd then - c_closesocket (fromIntegral $ toFd realFd) + c_closesocket (fromIntegral realFd) else #endif - c_close (fromIntegral $ toFd realFd) + c_close (fromIntegral realFd) -- release the lock *first*, because otherwise if we're preempted -- after closing but before releasing, the FD may have been reused. -- (#7646) release fd - closeWith closer (fromIntegral (fdFD fd) :: Fd) + closeFdWith closer (fromIntegral (fdFD fd)) release :: FD -> IO () release fd = do _ <- unlockFile (fromIntegral $ fdFD fd) diff --git a/libraries/base/GHC/IO/Types.hs b/libraries/base/GHC/IO/Types.hs deleted file mode 100644 index 3124c48052..0000000000 --- a/libraries/base/GHC/IO/Types.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, FlexibleInstances #-} -------------------------------------------------------------------------------- --- | --- Module : GHC.IO.Types --- Copyright : (c) Tamar Christina 2018 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : experimental --- Portability : non-portable --- --- Abstraction over C Handle types for GHC, Unix wants FD (CInt) while Windows --- Wants Handle (CIntPtr), so we abstract over them here. --- -------------------------------------------------------------------------------- - -module GHC.IO.Types - ( module GHC.IO.Types - , IntPtr - , POSIX.Fd) where - -import GHC.Base -import GHC.Num -import GHC.Real - -import Foreign.Ptr (IntPtr, intPtrToPtr) -import qualified System.Posix.Types as POSIX -import qualified GHC.Windows as WIN32 - --- To keep backwards compatibility with existing code we must use a type --- class here due to the different widths of the native handle types of the --- platforms. -class (Num a, Integral a) => BHandle a where - toFd :: a -> POSIX.Fd - toFd = fromIntegral - - toHandle :: a -> WIN32.HANDLE - toHandle = intPtrToPtr . fromIntegral - -instance BHandle POSIX.Fd where -instance BHandle IntPtr where diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal index fb6887911a..4877475a29 100644 --- a/libraries/base/base.cabal +++ b/libraries/base/base.cabal @@ -243,7 +243,6 @@ Library GHC.IO.Unsafe GHC.IO.SmartHandles GHC.IO.SubSystem - GHC.IO.Types GHC.IOArray GHC.IORef GHC.Int |