Ticket #7216: expose-threadWaitSTM-on-master.patch

File expose-threadWaitSTM-on-master.patch, 4.9 KB (added by AndreasVoellmy, 16 months ago)
  • Control/Concurrent.hs

    From a98a254a9a0b7c2dc5993237f7080c561d6658c2 Mon Sep 17 00:00:00 2001
    From: Andreas Voellmy <andreas.voellmy@gmail.com>
    Date: Sun, 30 Dec 2012 22:11:56 +0100
    Subject: [PATCH] Expose new threadWaitSTM functions in Control.Concurrent
     (see #7216).
    
    Control.Concurrent.threadWaitReadSTM and Control.Concurrent.threadWaitWriteSTM return errors on Windows.
    ---
     Control/Concurrent.hs |   29 ++++++++++++++++++++++++++++-
     GHC/Conc.lhs          |    2 ++
     GHC/Conc/IO.hs        |   43 +++++++++++++++++++++++++++++++++++++++++++
     3 files changed, 73 insertions(+), 1 deletion(-)
    
    diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
    index 100ccc5..0a94ebf 100644
    a b module Control.Concurrent ( 
    6666        threadDelay, 
    6767        threadWaitRead, 
    6868        threadWaitWrite, 
     69        threadWaitReadSTM, 
     70        threadWaitWriteSTM, 
    6971#endif 
    7072 
    7173        -- * Communication abstractions 
    import Control.Exception.Base as Exception 
    116118 
    117119#ifdef __GLASGOW_HASKELL__ 
    118120import GHC.Exception 
    119 import GHC.Conc hiding (threadWaitRead, threadWaitWrite) 
     121import GHC.Conc hiding (threadWaitRead, threadWaitWrite, 
     122                        threadWaitReadSTM, threadWaitWriteSTM) 
    120123import qualified GHC.Conc 
    121124import GHC.IO           ( IO(..), unsafeInterleaveIO, unsafeUnmask ) 
    122125import GHC.IORef        ( newIORef, readIORef, writeIORef ) 
    threadWaitWrite fd 
    448451  = GHC.Conc.threadWaitWrite fd 
    449452#endif 
    450453 
     454-- | Returns an STM action that can be used to wait for data 
     455-- to read from a file descriptor. The second returned value 
     456-- is an IO action that can be used to deregister interest 
     457-- in the file descriptor. 
     458threadWaitReadSTM :: Fd -> IO (GHC.Conc.STM (), IO ()) 
     459threadWaitReadSTM fd 
     460#ifdef mingw32_HOST_OS 
     461  = error "threadWaitReadSTM is not supported on Windows" 
     462#else 
     463  = GHC.Conc.threadWaitReadSTM fd 
     464#endif 
     465 
     466-- | Returns an STM action that can be used to wait until data 
     467-- can be written to a file descriptor. The second returned value 
     468-- is an IO action that can be used to deregister interest 
     469-- in the file descriptor. 
     470threadWaitWriteSTM :: Fd -> IO (GHC.Conc.STM (), IO ()) 
     471threadWaitWriteSTM fd  
     472#ifdef mingw32_HOST_OS 
     473  = error "threadWaitWriteSTM is not supported on Windows" 
     474#else 
     475  = GHC.Conc.threadWaitWriteSTM fd 
     476#endif 
     477 
    451478#ifdef mingw32_HOST_OS 
    452479foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool 
    453480 
  • GHC/Conc.lhs

    diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
    index 914db3f..f5fb275 100644
    a b module GHC.Conc 
    6262        , registerDelay 
    6363        , threadWaitRead 
    6464        , threadWaitWrite 
     65        , threadWaitReadSTM 
     66        , threadWaitWriteSTM 
    6567        , closeFdWith 
    6668 
    6769        -- * TVars 
  • GHC/Conc/IO.hs

    diff --git a/GHC/Conc/IO.hs b/GHC/Conc/IO.hs
    index 94a63a9..4a0c083 100644
    a b module GHC.Conc.IO 
    3838        , registerDelay 
    3939        , threadWaitRead 
    4040        , threadWaitWrite 
     41        , threadWaitReadSTM 
     42        , threadWaitWriteSTM 
    4143        , closeFdWith 
    4244 
    4345#ifdef mingw32_HOST_OS 
    module GHC.Conc.IO 
    5456#endif 
    5557        ) where 
    5658 
     59import Data.Maybe (Maybe(..), maybe) 
    5760import Foreign 
    5861import GHC.Base 
    5962import GHC.Conc.Sync as Sync 
    threadWaitWrite fd 
    108111        case waitWrite# fd# s of { s' -> (# s', () #) 
    109112        }} 
    110113 
     114-- | Returns an STM action that can be used to wait for data 
     115-- to read from a file descriptor. The second returned value 
     116-- is an IO action that can be used to deregister interest 
     117-- in the file descriptor. 
     118threadWaitReadSTM :: Fd -> IO (Sync.STM (), IO ()) 
     119threadWaitReadSTM fd  
     120#ifndef mingw32_HOST_OS 
     121  | threaded  = Event.threadWaitReadSTM fd 
     122#endif 
     123  | otherwise = do 
     124      m <- Sync.newTVarIO Nothing 
     125      Sync.forkIO $ do 
     126        threadWaitRead fd 
     127        Sync.atomically $ Sync.writeTVar m (Just ()) 
     128      let waitAction = do 
     129            e <- Sync.readTVar m 
     130            maybe Sync.retry return e 
     131      let killAction = return () 
     132      return (waitAction, killAction) 
     133 
     134-- | Returns an STM action that can be used to wait until data 
     135-- can be written to a file descriptor. The second returned value 
     136-- is an IO action that can be used to deregister interest 
     137-- in the file descriptor. 
     138threadWaitWriteSTM :: Fd -> IO (Sync.STM (), IO ()) 
     139threadWaitWriteSTM fd  
     140#ifndef mingw32_HOST_OS 
     141  | threaded  = Event.threadWaitWriteSTM fd 
     142#endif 
     143  | otherwise = do 
     144      m <- Sync.newTVarIO Nothing 
     145      Sync.forkIO $ do 
     146        threadWaitWrite fd 
     147        Sync.atomically $ Sync.writeTVar m (Just ()) 
     148      let waitAction = do 
     149            e <- Sync.readTVar m 
     150            maybe Sync.retry return e 
     151      let killAction = return () 
     152      return (waitAction, killAction) 
     153 
    111154-- | Close a file descriptor in a concurrency-safe way (GHC only).  If 
    112155-- you are using 'threadWaitRead' or 'threadWaitWrite' to perform 
    113156-- blocking I\/O, you /must/ use this function to close file