synchronous-channels 0.1 → 0.2
raw patch · 2 files changed
+16/−27 lines, 2 filesdep ~base
Dependency ranges changed: base
Files
Control/Concurrent/Chan/Synchronous.hs view
@@ -20,7 +20,7 @@ -- -- [Synchronous, non-blocking] These operations complete immediately -- if another thread is ready to synchronize, and otherwise return--- a failure code immediate.+-- a failure code immediately. -- -- [Asynchronous] These operations complete immediately and always -- succeed, though the value they send may not be received until@@ -195,7 +195,7 @@ getWriters (WQ q) = dequeue empty q clear :: IO a -> IORef (Maybe b) -> IO a-clear io r = block $ io `finally` writeIORef r Nothing+clear io r = uninterruptibleMask_ $ io `finally` writeIORef r Nothing -- | Make a new channel. newChan :: IO (Chan a)@@ -341,7 +341,7 @@ NoQ readers -> do message <- newEmptyMVar r <- newIORef (Just message)- commit (RQ (readers |> r))+ commit (RQ (readers |> r)) :: IO () return $ do a <- takeMVar message `clear` r -- Race condition here! I think we'd need a different@@ -354,7 +354,7 @@ Just a -> do r' <- newIORef (Just a') confirm' <- newEmptyMVar- block $ do+ uninterruptibleMask_ $ do putMVar confirm () commit (WQ ((r', confirm') <| writers)) return $ do@@ -584,7 +584,7 @@ loop [] e = return (e, Success (Success (), [])) loop (a:as) e = do case getReaders e of- r :< readers -> block $ do+ r :< readers -> uninterruptibleMask_ $ do maybereader <- readIORef r case maybereader of Just reader -> do@@ -608,17 +608,9 @@ --- Helpful MVar stuff --- -saveBlock :: IO (IO a -> IO a)-saveBlock = do- b <- blocked- case b of- True -> return block- False -> return unblock- modifyMVar :: MVar a -> (a -> IO (a, b)) -> IO b-modifyMVar m io = do- restore <- saveBlock- block $ do+modifyMVar m io =+ uninterruptibleMask $ \restore -> do a <- takeMVar m (a',b) <- restore (io a) `onException` putMVar m a@@ -628,9 +620,8 @@ -- Control.Concurrent.MVar doesn't have this, but it's pretty useful -- for implementing non-blocking operations. tryModifyMVar :: MVar a -> (a -> IO (a, TryResult b)) -> IO (TryResult b)-tryModifyMVar m io = do- restore <- saveBlock- block $ do+tryModifyMVar m io =+ uninterruptibleMask $ \restore -> do maybea <- tryTakeMVar m case maybea of Just a -> do@@ -644,9 +635,8 @@ transactMVar :: MVar a -> (a -> (a -> IO ()) -> IO b) -> IO b-transactMVar m io = do- restore <- saveBlock- block $ do+transactMVar m io =+ uninterruptibleMask $ \restore -> do a <- takeMVar m r <- newIORef a restore (io a (writeIORef r))@@ -656,9 +646,8 @@ tryTransactMVar :: MVar a -> (a -> (a -> IO ()) -> IO (TryResult b)) -> IO (TryResult b)-tryTransactMVar m io = do- restore <- saveBlock- block $ do+tryTransactMVar m io =+ uninterruptibleMask $ \restore -> do maybea <- tryTakeMVar m case maybea of Just a -> do
synchronous-channels.cabal view
@@ -1,5 +1,5 @@ Name: synchronous-channels-Version: 0.1+Version: 0.2 Cabal-Version: >= 1.2.3 License: BSD3 License-File: LICENSE@@ -9,14 +9,14 @@ Category: Concurrency, Control Synopsis: Synchronous communication channels Build-type: Simple-Tested-with: GHC == 6.10.1+Tested-with: GHC == 7.8.3 Description: Synchronous communication channels. These are similar to 'Control.Concurrent.Chan.Chan', but a writer blocks until it can synchronize with a reader. Library- Build-Depends: base >= 4+ Build-Depends: base >= 4 && < 5 GHC-Options: -W -Wall Exposed-modules: