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

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

    From a98a254a9a0b7c2dc5993237f7080c561d6658c2 Mon Sep 17 00:00:00 2001
    From: Andreas Voellmy <[email protected]>
    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