[commit: base] : Undo recent change to the type of GHC.Event.Thread.getSystemEventManager and update the commentary on this function. (8a3f516)

[Johan Tibell]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/8a3f5163982ad5711e86fb9a4bdfa819ff4e924b

>---------------------------------------------------------------

commit 8a3f5163982ad5711e86fb9a4bdfa819ff4e924b
Author: Andreas Voellmy <andreas.voellmy at gmail.com>
Date:   Fri Jan 4 10:34:32 2013 -0500

    Undo recent change to the type of GHC.Event.Thread.getSystemEventManager and update the commentary on this function.

>---------------------------------------------------------------

 GHC/Event/Thread.hs |   21 ++++++++++++++-------
 1 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs
index b0d55a6..2c8906e 100644
--- a/GHC/Event/Thread.hs
+++ b/GHC/Event/Thread.hs
@@ -114,7 +114,7 @@ closeFdWith close fd = do
 threadWait :: Event -> Fd -> IO ()
 threadWait evt fd = mask_ $ do
   m <- newEmptyMVar
-  mgr <- getSystemEventManager
+  mgr <- getSystemEventManager_
   reg <- registerFd mgr (\_ e -> putMVar m e) fd evt
   evt' <- takeMVar m `onException` unregisterFd_ mgr reg
   if evt' `eventIs` evtClose
@@ -125,7 +125,7 @@ threadWait evt fd = mask_ $ do
 threadWaitSTM :: Event -> Fd -> IO (STM (), IO ())
 threadWaitSTM evt fd = mask_ $ do
   m <- newTVarIO Nothing
-  mgr <- getSystemEventManager
+  mgr <- getSystemEventManager_
   reg <- registerFd mgr (\_ e -> atomically (writeTVar m (Just e))) fd evt
   let waitAction =
         do mevt <- readTVar m
@@ -162,17 +162,24 @@ threadWaitWriteSTM = threadWaitSTM evtWrite
 {-# INLINE threadWaitWriteSTM #-}
 
 
--- | Retrieve the system event manager.
+-- | Retrieve the system event manager for the capability on which the
+-- calling thread is running.
 --
--- This function always returns 'Just' the system event manager when using the
--- threaded RTS and 'Nothing' otherwise.
-getSystemEventManager :: IO EventManager
+-- This function always returns 'Just' the current thread's event manager
+-- when using the threaded RTS and 'Nothing' otherwise.
+getSystemEventManager :: IO (Maybe EventManager)
 getSystemEventManager = do
   t <- myThreadId
   (cap, _) <- threadCapability t
   eventManagerArray <- readIORef eventManager
-  Just (_,mgr) <- readIOArray eventManagerArray cap
+  mmgr <- readIOArray eventManagerArray cap
+  return $ fmap snd mmgr
+
+getSystemEventManager_ :: IO EventManager
+getSystemEventManager_ = do
+  Just mgr <- getSystemEventManager
   return mgr
+{-# INLINE getSystemEventManager_ #-}
 
 foreign import ccall unsafe "getOrSetSystemEventThreadEventManagerStore"
     getOrSetSystemEventThreadEventManagerStore :: Ptr a -> IO (Ptr a)