[commit: packages/primitive] ghc-head: Add strict variants of MutVar modification functions. (e5e78d1)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/primitive

On branch  : ghc-head
Link       : http://git.haskell.org/packages/primitive.git/commitdiff/e5e78d10917af61184c0c4da2050e65ce250b7af

>---------------------------------------------------------------

commit e5e78d10917af61184c0c4da2050e65ce250b7af
Author: Ian Duncan <ian.duncan at logos.com>
Date:   Mon Oct 28 21:09:16 2013 -0700

    Add strict variants of MutVar modification functions.


>---------------------------------------------------------------

e5e78d10917af61184c0c4da2050e65ce250b7af
 Data/Primitive/MutVar.hs |   22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/Data/Primitive/MutVar.hs b/Data/Primitive/MutVar.hs
index d3fee67..f707bfb 100644
--- a/Data/Primitive/MutVar.hs
+++ b/Data/Primitive/MutVar.hs
@@ -19,7 +19,9 @@ module Data.Primitive.MutVar (
   writeMutVar,
 
   atomicModifyMutVar,
-  modifyMutVar
+  atomicModifyMutVar',
+  modifyMutVar,
+  modifyMutVar'
 ) where
 
 import Control.Monad.Primitive ( PrimMonad(..), primitive_ )
@@ -58,9 +60,27 @@ atomicModifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a,b)) -> m
 {-# INLINE atomicModifyMutVar #-}
 atomicModifyMutVar (MutVar mv#) f = primitive $ atomicModifyMutVar# mv# f
 
+-- | Strict version of 'atomicModifyMutVar'. This forces both the value stored
+-- in the 'MutVar' as well as the value returned.
+atomicModifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a, b)) -> m b
+{-# INLINE atomicModifyMutVar' #-}
+atomicModifyMutVar' mv f = do
+  b <- atomicModifyMutVar mv force
+  b `seq` return b
+  where
+    force x = let (a, b) = f x in (a, a `seq` b)
+
 -- | Mutate the contents of a 'MutVar'
 modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m ()
 {-# INLINE modifyMutVar #-}
 modifyMutVar (MutVar mv#) g = primitive_ $ \s# ->
   case readMutVar# mv# s# of
     (# s'#, a #) -> writeMutVar# mv# (g a) s'#
+
+-- | Strict version of 'modifyMutVar'
+modifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m ()
+{-# INLINE modifyMutVar' #-}
+modifyMutVar' (MutVar mv#) g = primitive_ $ \s# ->
+  case readMutVar# mv# s# of
+    (# s'#, a #) -> let a' = g a in a' `seq` writeMutVar# mv# a' s'#
+