4 patches for repository http://darcs.haskell.org/packages/stm: Sat Mar 26 05:01:15 EDT 2011 wren ng thornton * Control.Concurrent.STM.TChan: added tryReadTChan, peekTChan, tryPeekTChan Sat Mar 26 05:04:27 EDT 2011 wren ng thornton * Control.Concurrent.STM.TMVar: added tryReadTMVar Sat Mar 26 05:06:08 EDT 2011 wren ng thornton * Control.Concurrent.STM.TVar: cleaning up order of exports Sat Mar 26 05:11:30 EDT 2011 wren ng thornton * Control.Concurrent.STM.TVar: added modifyTVar, modifyTVar', swapTVar New patches: [Control.Concurrent.STM.TChan: added tryReadTChan, peekTChan, tryPeekTChan wren ng thornton **20110326090115 Ignore-this: 9a29c000dc0608699b26a7877396dde8 ] { hunk ./Control/Concurrent/STM/TChan.hs 26 newTChan, newTChanIO, readTChan, + tryReadTChan, + peekTChan, + tryPeekTChan, writeTChan, dupTChan, unGetTChan, hunk ./Control/Concurrent/STM/TChan.hs 85 writeTVar read tail return a +-- | Non-blocking version of 'readTChan'. +tryReadTChan :: TChan a -> STM (Maybe a) +tryReadTChan (TChan read _write) = do + listhead <- readTVar read + head <- readTVar listhead + case head of + TNil -> return Nothing + TCons a tl -> do + writeTVar read tl + return (Just a) + +-- | Get the next value from the 'TChan' without removing it, +-- blocking if the channel is empty. +peekTChan :: TChan a -> STM a +peekTChan (TChan read _write) = do + listhead <- readTVar read + head <- readTVar listhead + case head of + TNil -> retry + TCons a _ -> return a + +-- | Non-blocking version of 'peekTChan'. +tryPeekTChan :: TChan a -> STM (Maybe a) +tryPeekTChan (TChan read _write) = do + listhead <- readTVar read + head <- readTVar listhead + case head of + TNil -> return Nothing + TCons a _ -> return (Just a) + -- |Duplicate a 'TChan': the duplicate channel begins empty, but data written to -- either channel from then on will be available from both. Hence this creates -- a kind of broadcast channel, where data written by anyone is seen by } [Control.Concurrent.STM.TMVar: added tryReadTMVar wren ng thornton **20110326090427 Ignore-this: c33d8ac654b0b9e24e1d969858f17151 ] { hunk ./Control/Concurrent/STM/TMVar.hs 29 takeTMVar, putTMVar, readTMVar, + tryReadTMVar, swapTMVar, tryTakeTMVar, tryPutTMVar, hunk ./Control/Concurrent/STM/TMVar.hs 119 Nothing -> do writeTVar t (Just a); return True Just _ -> return False -{-| - This is a combination of 'takeTMVar' and 'putTMVar'; ie. it takes the value - from the 'TMVar', puts it back, and also returns it. --} +-- | This is a combination of 'takeTMVar' and 'putTMVar'; ie. it +-- takes the value from the 'TMVar', puts it back, and also returns +-- it. readTMVar :: TMVar a -> STM a readTMVar (TMVar t) = do m <- readTVar t hunk ./Control/Concurrent/STM/TMVar.hs 129 Nothing -> retry Just a -> return a +-- | Non-blocking version of 'readTMVar'. +tryReadTMVar :: TMVar a -> STM (Maybe a) +tryReadTMVar (TMVar t) = readTVar t + -- |Swap the contents of a 'TMVar' for a new value. swapTMVar :: TMVar a -> a -> STM a swapTMVar (TMVar t) new = do } [Control.Concurrent.STM.TVar: cleaning up order of exports wren ng thornton **20110326090608 Ignore-this: 292f6cc492ab6f29b1b47cdb87f96c58 ] { hunk ./Control/Concurrent/STM/TVar.hs 19 -- * TVars TVar, newTVar, + newTVarIO, readTVar, hunk ./Control/Concurrent/STM/TVar.hs 21 + readTVarIO, writeTVar, hunk ./Control/Concurrent/STM/TVar.hs 23 - newTVarIO, - readTVarIO, #ifdef __GLASGOW_HASKELL__ registerDelay #endif } [Control.Concurrent.STM.TVar: added modifyTVar, modifyTVar', swapTVar wren ng thornton **20110326091130 Ignore-this: c86be3f79f528c4c50acbb5b525579d ] { hunk ./Control/Concurrent/STM/TVar.hs 23 readTVar, readTVarIO, writeTVar, + modifyTVar, + modifyTVar', + swapTVar, #ifdef __GLASGOW_HASKELL__ registerDelay #endif hunk ./Control/Concurrent/STM/TVar.hs 40 #if ! (MIN_VERSION_base(4,2,0)) readTVarIO = atomically . readTVar #endif + + +-- Like 'modifyIORef' but for 'TVar'. +-- | Mutate the contents of a 'TVar'. /N.B./, this version is +-- non-strict. +modifyTVar :: TVar a -> (a -> a) -> STM () +modifyTVar var f = do + x <- readTVar var + writeTVar var (f x) +{-# INLINE modifyTVar #-} + + +-- | Strict version of 'modifyTVar'. +modifyTVar' :: TVar a -> (a -> a) -> STM () +modifyTVar' var f = do + x <- readTVar var + writeTVar var $! f x +{-# INLINE modifyTVar' #-} + + +-- Like 'swapTMVar' but for 'TVar'. +-- | Swap the contents of a 'TVar' for a new value. +swapTVar :: TVar a -> a -> STM a +swapTVar var new = do + old <- readTVar var + writeTVar var new + return old +{-# INLINE swapTVar #-} + } Context: [bump major (new MonadFix instance) Simon Marlow **20110325125427 Ignore-this: cd44d2e5e15e5d730dd81ec858dab61a ] [warning fix Simon Marlow **20110325125418 Ignore-this: 2ae31dd3955fc225067994eaecc4ddc0 ] [Add MonadFix instance (from proposal by Sebastiaan Visser on libraries@) Simon Marlow **20110325125329 Ignore-this: de23ac9a8e601ec332d19fce16bc525e ] [Fix stackoverflow in the newArray methods of a TArray Bas van Dijk **20110323193403 Ignore-this: 10cef64e25fce410438c53998926e93c The following caused a stackoverflow: atomically $ (newArray_ (0,1000000) :: STM (TArray Int Int)) This happened because newArray_ was defined using replicateM which is defined using sequence which uses a right fold which pushes the result of the monadic computation on the stack then continues with the rest until the stack overflows. ] [remove imports of haskell98 modules Simon Marlow **20110208090214 Ignore-this: 41b13459c2e705a07fab1844843ccc79 ] [bump version to 2.2.0.1 Simon Marlow **20101103085737 Ignore-this: 6db4cc991b3f41d16076a981190e8840 ] [make it build with GHC 6.12 Simon Marlow **20101103085617 Ignore-this: ebec5b0b71f993cf514cf0cc157438c2 ] [Warning police: -fglasgow-exts is deprecated: Use individual extensions instead Bas van Dijk **20101020221951 Ignore-this: 7e020511b7393a0b082045e9052e2925 ] [bump version to 2.2.0.0 following change to catchSTM Simon Marlow **20101020140150 Ignore-this: 813b845ed1e5d5c2f924f74ec3b66707 ] [update tests after change to catchSTM Simon Marlow **20101020140046 Ignore-this: a54d40df362f7d19966d47eec8b95a69 ] [Add throwSTM :: Exception e => e -> STM a Bas van Dijk **20100926181824 Ignore-this: fba233747030912f882ef02b984f6b6a ] [add parens around MIN_VERSION_base(4,3,0) to workaround bug with older Cabal Simon Marlow **20101005093658 Ignore-this: fc8bab7a7fd50eed2be06a1adfabb810 ] [TAG 2.1.2.2 Simon Marlow **20100715153144 Ignore-this: dd4843fc8b82f206ff61ae95968cddd6 ] Patch bundle hash: d1dfeb0238e72c6d176bfa68d8bba6942f832db3