Rename System.Event to GHC.Event

[ghc-base.git] / System / Event / Thread.hs

diff --git a/System/Event/Thread.hs b/System/Event/Thread.hs
deleted file mode 100644 (file)
index 9c58a5a..0000000
--- a/System/Event/Thread.hs
+++ /dev/null
@@ -1,143 +0,0 @@
-{-# LANGUAGE BangPatterns, ForeignFunctionInterface, NoImplicitPrelude #-}
-
-module System.Event.Thread
-    (
-      ensureIOManagerIsRunning
-    , threadWaitRead
-    , threadWaitWrite
-    , closeFdWith
-    , threadDelay
-    , registerDelay
-    ) where
-
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Maybe (Maybe(..))
-import Foreign.C.Error (eBADF, errnoToIOError)
-import Foreign.Ptr (Ptr)
-import GHC.Base
-import GHC.Conc.Sync (TVar, ThreadId, ThreadStatus(..), atomically, forkIO,
-                      labelThread, modifyMVar_, newTVar, sharedCAF,
-                      threadStatus, writeTVar)
-import GHC.IO (mask_, onException)
-import GHC.IO.Exception (ioError)
-import GHC.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar)
-import System.Event.Internal (eventIs, evtClose)
-import System.Event.Manager (Event, EventManager, evtRead, evtWrite, loop,
-                             new, registerFd, unregisterFd_, registerTimeout)
-import qualified System.Event.Manager as M
-import System.IO.Unsafe (unsafePerformIO)
-import System.Posix.Types (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 usecs = mask_ $ do
-  Just mgr <- readIORef eventManager
-  m <- newEmptyMVar
-  reg <- registerTimeout mgr usecs (putMVar m ())
-  takeMVar m `onException` M.unregisterTimeout mgr reg
-
--- | Set the value of returned TVar to True after a given number of
--- microseconds. The caveats associated with threadDelay also apply.
---
-registerDelay :: Int -> IO (TVar Bool)
-registerDelay usecs = do
-  t <- atomically $ newTVar False
-  Just mgr <- readIORef eventManager
-  _ <- registerTimeout mgr usecs . atomically $ writeTVar t True
-  return t
-
--- | Block the current thread until data is available to read from the
--- given file descriptor.
---
--- This will throw an '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 = threadWait evtRead
-{-# INLINE threadWaitRead #-}
-
--- | Block the current thread until the given file descriptor can
--- accept data to write.
---
--- This will throw an '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 = threadWait evtWrite
-{-# INLINE threadWaitWrite #-}
-
--- | Close a file descriptor in a concurrency-safe way.
---
--- Any threads that are blocked on the file descriptor via
--- 'threadWaitRead' or 'threadWaitWrite' will be unblocked by having
--- IO exceptions thrown.
-closeFdWith :: (Fd -> IO ())        -- ^ Action that performs the close.
-            -> Fd                   -- ^ File descriptor to close.
-            -> IO ()
-closeFdWith close fd = do
-  Just mgr <- readIORef eventManager
-  M.closeFd mgr close fd
-
-threadWait :: Event -> Fd -> IO ()
-threadWait evt fd = mask_ $ do
-  m <- newEmptyMVar
-  Just mgr <- readIORef eventManager
-  reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> putMVar m e) fd evt
-  evt' <- takeMVar m `onException` unregisterFd_ mgr reg
-  if evt' `eventIs` evtClose
-    then ioError $ errnoToIOError "threadWait" eBADF Nothing Nothing
-    else return ()
-
-foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
-    getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)
-
-eventManager :: IORef (Maybe EventManager)
-eventManager = unsafePerformIO $ do
-    em <- newIORef Nothing
-    sharedCAF em getOrSetSystemEventThreadEventManagerStore
-{-# NOINLINE eventManager #-}
-
-foreign import ccall unsafe "getOrSetSystemEventThreadIOManagerThreadStore"
-    getOrSetSystemEventThreadIOManagerThreadStore :: Ptr a -> IO (Ptr a)
-
-{-# NOINLINE ioManager #-}
-ioManager :: MVar (Maybe ThreadId)
-ioManager = unsafePerformIO $ do
-   m <- newMVar Nothing
-   sharedCAF m getOrSetSystemEventThreadIOManagerThreadStore
-
-ensureIOManagerIsRunning :: IO ()
-ensureIOManagerIsRunning
-  | not threaded = return ()
-  | otherwise = modifyMVar_ ioManager $ \old -> do
-  let create = do
-        !mgr <- new
-        writeIORef eventManager $ Just mgr
-        !t <- forkIO $ loop mgr
-        labelThread t "IOManager"
-        return $ Just t
-  case old of
-    Nothing            -> create
-    st@(Just t) -> do
-      s <- threadStatus t
-      case s of
-        ThreadFinished -> create
-        ThreadDied     -> do 
-          -- Sanity check: if the thread has died, there is a chance
-          -- that event manager is still alive. This could happend during
-          -- the fork, for example. In this case we should clean up
-          -- open pipes and everything else related to the event manager.
-          -- See #4449
-          mem <- readIORef eventManager
-          _ <- case mem of
-                 Nothing -> return ()
-                 Just em -> M.cleanup em
-          create
-        _other         -> return st
-
-foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool