Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0ed5c8b7687037e5815eab4701f0ac1ea117e046 >--------------------------------------------------------------- commit 0ed5c8b7687037e5815eab4701f0ac1ea117e046 Author: Andreas Voellmy <[email protected]> Date: Wed Oct 17 11:02:12 2012 -0400 Added the unregistration command to the return value of threadWait*STM functions. This allows the calling thread to unregister interest in the file, e.g. in the case of an exception in the thread. >--------------------------------------------------------------- GHC/Event/Thread.hs | 41 +++++++++++++++++++++++++++++------------ 1 files changed, 29 insertions(+), 12 deletions(-) diff --git a/GHC/Event/Thread.hs b/GHC/Event/Thread.hs index 7df531f..1f19756 100644 --- a/GHC/Event/Thread.hs +++ b/GHC/Event/Thread.hs @@ -98,25 +98,42 @@ threadWait evt fd = mask_ $ do else return () -threadWaitSTM :: Event -> Fd -> IO (STM ()) +threadWaitSTM :: Event -> Fd -> IO (STM (), IO ()) threadWaitSTM evt fd = mask_ $ do m <- newTVarIO Nothing Just mgr <- getSystemEventManager - registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt - return (do mevt <- readTVar m - case mevt of - Nothing -> retry - Just evt -> - if evt `eventIs` evtClose - then throwSTM $ errnoToIOError "threadWait" eBADF Nothing Nothing - else return () - ) - -threadWaitReadSTM :: Fd -> IO (STM ()) + reg <- registerFd mgr (\reg e -> unregisterFd_ mgr reg >> atomically (writeTVar m (Just e))) fd evt + let waitAction = + do mevt <- readTVar m + case mevt of + Nothing -> retry + Just evt -> + if evt `eventIs` evtClose + then throwSTM $ errnoToIOError "threadWaitSTM" eBADF Nothing Nothing + else return () + return (waitAction, unregisterFd_ mgr reg >> return ()) + +-- | Allows a thread to use an STM action to wait for a file descriptor to be readable. +-- The STM action will retry until the file descriptor has data ready. +-- The second element of the return value pair is an IO action that can be used +-- to deregister interest in the file descriptor. +-- +-- The STM action will throw an 'IOError' if the file descriptor was closed +-- while the STM action is being executed. To safely close a file descriptor +-- that has been used with 'threadWaitReadSTM', use 'closeFdWith'. +threadWaitReadSTM :: Fd -> IO (STM (), IO ()) threadWaitReadSTM = threadWaitSTM evtRead {-# INLINE threadWaitReadSTM #-} -threadWaitWriteSTM :: Fd -> IO (STM ()) +-- | Allows a thread to use an STM action to wait until a file descriptor can accept a write. +-- The STM action will retry while the file until the given file descriptor can accept a write. +-- The second element of the return value pair is an IO action that can be used to deregister +-- interest in the file descriptor. +-- +-- The STM action will throw an 'IOError' if the file descriptor was closed +-- while the STM action is being executed. To safely close a file descriptor +-- that has been used with 'threadWaitWriteSTM', use 'closeFdWith'. +threadWaitWriteSTM :: Fd -> IO (STM (), IO ()) threadWaitWriteSTM = threadWaitSTM evtWrite {-# INLINE threadWaitWriteSTM #-} _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
