GHC/Conc/IO.hs (original) (raw)

#include "Typeable.h"

module GHC.Conc.IO ( ensureIOManagerIsRunning

    , threadDelay           
    , registerDelay         
    , threadWaitRead        
    , threadWaitWrite       
    , closeFdWith           

#ifdef mingw32_HOST_OS , asyncRead
, asyncWrite
, asyncDoProc

    , asyncReadBA   
    , asyncWriteBA  

    , ConsoleEvent(..)
    , win32ConsoleHandler
    , toWin32ConsoleEvent

#endif ) where

import Foreign import GHC.Base import GHC.Conc.Sync as Sync import GHC.Real ( fromIntegral ) import System.Posix.Types

#ifdef mingw32_HOST_OS import qualified GHC.Conc.Windows as Windows import GHC.Conc.Windows (asyncRead, asyncWrite, asyncDoProc, asyncReadBA, asyncWriteBA, ConsoleEvent(..), win32ConsoleHandler, toWin32ConsoleEvent) #else import qualified GHC.Event.Thread as Event #endif

ensureIOManagerIsRunning :: IO () #ifndef mingw32_HOST_OS ensureIOManagerIsRunning = Event.ensureIOManagerIsRunning #else ensureIOManagerIsRunning = Windows.ensureIOManagerIsRunning #endif

threadWaitRead :: Fd -> IO () threadWaitRead fd #ifndef mingw32_HOST_OS | threaded = Event.threadWaitRead fd #endif | otherwise = IO $ \s -> case fromIntegral fd of { I# fd# -> case waitRead# fd# s of { s' -> (# s', () #) }}

threadWaitWrite :: Fd -> IO () threadWaitWrite fd #ifndef mingw32_HOST_OS | threaded = Event.threadWaitWrite fd #endif | otherwise = IO $ \s -> case fromIntegral fd of { I# fd# -> case waitWrite# fd# s of { s' -> (# s', () #) }}

closeFdWith :: (Fd -> IO ()) -> Fd
-> IO () closeFdWith close fd #ifndef mingw32_HOST_OS | threaded = Event.closeFdWith close fd #endif | otherwise = close fd

threadDelay :: Int -> IO () threadDelay time #ifdef mingw32_HOST_OS | threaded = Windows.threadDelay time #else | threaded = Event.threadDelay time #endif | otherwise = IO $ \s -> case time of { I# time# -> case delay# time# s of { s' -> (# s', () #) }}

registerDelay :: Int -> IO (TVar Bool) registerDelay usecs #ifdef mingw32_HOST_OS | threaded = Windows.registerDelay usecs #else | threaded = Event.registerDelay usecs #endif | otherwise = error "registerDelay: requires -threaded"

foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool