{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP
 , NoImplicitPrelude
 , MagicHash
 , UnboxedTuples
 #-}{-# OPTIONS_GHC -Wno-missing-signatures #-}{-# OPTIONS_HADDOCK not-home #-}------------------------------------------------------------------------------- |-- Module : GHC.Conc.IO-- Copyright : (c) The University of Glasgow, 1994-2002-- License : see libraries/base/LICENSE---- Maintainer : cvs-ghc@haskell.org-- Stability : internal-- Portability : non-portable (GHC extensions)---- Basic concurrency stuff.--------------------------------------------------------------------------------- No: #hide, because bits of this module are exposed by the stm package.-- However, we don't want this module to be the home location for the-- bits it exports, we'd rather have Control.Concurrent and the other-- higher level modules be the home. Hence: #not-homemoduleGHC.Conc.IO(ensureIOManagerIsRunning ,ioManagerCapabilitiesChanged -- * Waiting,threadDelay ,registerDelay ,threadWaitRead ,threadWaitWrite ,threadWaitReadSTM ,threadWaitWriteSTM ,closeFdWith 
#if defined(mingw32_HOST_OS)
,asyncRead,asyncWrite,asyncDoProc,asyncReadBA,asyncWriteBA,ConsoleEvent(..),win32ConsoleHandler,toWin32ConsoleEvent
#endif
)whereimportForeign importGHC.Base importGHC.Conc.Sync asSyncimportGHC.Real (fromIntegral )importSystem.Posix.Types 
#if defined(mingw32_HOST_OS)
importqualifiedGHC.Conc.WindowsasWindowsimportGHC.Conc.Windows(asyncRead,asyncWrite,asyncDoProc,asyncReadBA,asyncWriteBA,ConsoleEvent(..),win32ConsoleHandler,toWin32ConsoleEvent)
#else
importqualifiedGHC.Event.Thread asEvent
#endif
ensureIOManagerIsRunning ::IO()
#if !defined(mingw32_HOST_OS)
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning =IO ()
Event.ensureIOManagerIsRunning 
#else
ensureIOManagerIsRunning=Windows.ensureIOManagerIsRunning
#endif
ioManagerCapabilitiesChanged ::IO()
#if !defined(mingw32_HOST_OS)
ioManagerCapabilitiesChanged :: IO ()
ioManagerCapabilitiesChanged =IO ()
Event.ioManagerCapabilitiesChanged 
#else
ioManagerCapabilitiesChanged=return()
#endif
-- | Block the current thread until data is available to read on the-- given file descriptor (GHC only).---- 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'.threadWaitRead ::Fd ->IO()threadWaitRead :: Fd -> IO ()
threadWaitRead Fd
fd 
#if !defined(mingw32_HOST_OS)
|Bool
threaded =Fd -> IO ()
Event.threadWaitRead Fd
fd 
#endif
|Bool
otherwise =(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->caseFd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd of{I#Int#
fd# ->caseInt# -> State# RealWorld -> State# RealWorld
forall d. Int# -> State# d -> State# d
waitRead#Int#
fd# State# RealWorld
s of{State# RealWorld
s' ->(#State# RealWorld
s' ,()#)}}-- | Block the current thread until data can be written to the-- given file descriptor (GHC only).---- 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'.threadWaitWrite ::Fd ->IO()threadWaitWrite :: Fd -> IO ()
threadWaitWrite Fd
fd 
#if !defined(mingw32_HOST_OS)
|Bool
threaded =Fd -> IO ()
Event.threadWaitWrite Fd
fd 
#endif
|Bool
otherwise =(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->caseFd -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd of{I#Int#
fd# ->caseInt# -> State# RealWorld -> State# RealWorld
forall d. Int# -> State# d -> State# d
waitWrite#Int#
fd# State# RealWorld
s of{State# RealWorld
s' ->(#State# RealWorld
s' ,()#)}}-- | Returns an STM action that can be used to wait for data-- to read from a file descriptor. The second returned value-- is an IO action that can be used to deregister interest-- in the file descriptor.threadWaitReadSTM ::Fd ->IO(Sync.STM (),IO())threadWaitReadSTM :: Fd -> IO (STM (), IO ())
threadWaitReadSTM Fd
fd 
#if !defined(mingw32_HOST_OS)
|Bool
threaded =Fd -> IO (STM (), IO ())
Event.threadWaitReadSTM Fd
fd 
#endif
|Bool
otherwise =doTVar Bool
m <-Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
Sync.newTVarIO Bool
FalseThreadId
t <-IO () -> IO ThreadId
Sync.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ doFd -> IO ()
threadWaitRead Fd
fd STM () -> IO ()
forall a. STM a -> IO a
Sync.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
Sync.writeTVar TVar Bool
m Bool
TrueletwaitAction :: STM ()
waitAction =doBool
b <-TVar Bool -> STM Bool
forall a. TVar a -> STM a
Sync.readTVar TVar Bool
m ifBool
b then() -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()elseSTM ()
forall a. STM a
retry letkillAction :: IO ()
killAction =ThreadId -> IO ()
Sync.killThread ThreadId
t (STM (), IO ()) -> IO (STM (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (STM ()
waitAction ,IO ()
killAction )-- | Returns an STM action that can be used to wait until data-- can be written to a file descriptor. The second returned value-- is an IO action that can be used to deregister interest-- in the file descriptor.threadWaitWriteSTM ::Fd ->IO(Sync.STM (),IO())threadWaitWriteSTM :: Fd -> IO (STM (), IO ())
threadWaitWriteSTM Fd
fd 
#if !defined(mingw32_HOST_OS)
|Bool
threaded =Fd -> IO (STM (), IO ())
Event.threadWaitWriteSTM Fd
fd 
#endif
|Bool
otherwise =doTVar Bool
m <-Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
Sync.newTVarIO Bool
FalseThreadId
t <-IO () -> IO ThreadId
Sync.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ doFd -> IO ()
threadWaitWrite Fd
fd STM () -> IO ()
forall a. STM a -> IO a
Sync.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
Sync.writeTVar TVar Bool
m Bool
TrueletwaitAction :: STM ()
waitAction =doBool
b <-TVar Bool -> STM Bool
forall a. TVar a -> STM a
Sync.readTVar TVar Bool
m ifBool
b then() -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()elseSTM ()
forall a. STM a
retry letkillAction :: IO ()
killAction =ThreadId -> IO ()
Sync.killThread ThreadId
t (STM (), IO ()) -> IO (STM (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (STM ()
waitAction ,IO ()
killAction )-- | 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 file descriptor via-- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having-- IO exceptions thrown.closeFdWith ::(Fd ->IO())-- ^ Low-level action that performs the real close.->Fd -- ^ File descriptor to close.->IO()closeFdWith :: (Fd -> IO ()) -> Fd -> IO ()
closeFdWith Fd -> IO ()
close Fd
fd 
#if !defined(mingw32_HOST_OS)
|Bool
threaded =(Fd -> IO ()) -> Fd -> IO ()
Event.closeFdWith Fd -> IO ()
close Fd
fd 
#endif
|Bool
otherwise =Fd -> IO ()
close Fd
fd -- | Suspends the current thread for a given number of microseconds-- (GHC only).---- There is no guarantee that the thread will be rescheduled promptly-- when the delay has expired, but the thread will never continue to-- run /earlier/ than specified.--threadDelay ::Int->IO()threadDelay :: Int -> IO ()
threadDelay Int
time 
#if defined(mingw32_HOST_OS)
|threaded=Windows.threadDelaytime
#else
|Bool
threaded =Int -> IO ()
Event.threadDelay Int
time 
#endif
|Bool
otherwise =(State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \State# RealWorld
s ->caseInt
time of{I#Int#
time# ->caseInt# -> State# RealWorld -> State# RealWorld
forall d. Int# -> State# d -> State# d
delay#Int#
time# State# RealWorld
s of{State# RealWorld
s' ->(#State# RealWorld
s' ,()#)}}-- | Switch the value of returned 'TVar' from initial value 'False' to 'True'-- after a given number of microseconds. The caveats associated with-- 'threadDelay' also apply.--registerDelay ::Int->IO(TVar Bool)registerDelay :: Int -> IO (TVar Bool)
registerDelay Int
usecs 
#if defined(mingw32_HOST_OS)
|threaded=Windows.registerDelayusecs
#else
|Bool
threaded =Int -> IO (TVar Bool)
Event.registerDelay Int
usecs 
#endif
|Bool
otherwise =[Char] -> IO (TVar Bool)
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"registerDelay: requires -threaded"foreignimportccallunsafe"rtsSupportsBoundThreads"threaded ::Bool