From 50e65e1494a66217ab03af62fbd8fa9c3ad54661 Mon Sep 17 00:00:00 2001
From: Andreas Voellmy <andreas.voellmy@gmail.com>
Date: Fri, 4 Jan 2013 10:34:32 -0500
Subject: Undo recent change to the type of
 GHC.Event.Thread.getSystemEventManager and update the commentary on this
 function.

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

(limited to 'libraries')

diff --git a/libraries/base/GHC/Event/Thread.hs b/libraries/base/GHC/Event/Thread.hs
index b0d55a636b..2c8906e3ab 100644
--- a/libraries/base/GHC/Event/Thread.hs
+++ b/libraries/base/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)
-- 
cgit v1.2.1