[commit: ghc] master: Optimise atomicModifyIORef' implementation (#8345) (9e2cb00)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9e2cb00e5af9d86546f82a74c3d0382e65704d56/ghc

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

commit 9e2cb00e5af9d86546f82a74c3d0382e65704d56
Author: David Feuer <David.Feuer at gmail.com>
Date:   Mon Oct 27 10:21:20 2014 +0100

    Optimise atomicModifyIORef' implementation (#8345)
    
    This forces the new value before installing it in the IORef.
    
    This optimisation was originally suggested by Patrick Palka
    and "exhibits a speedup of 1.7x (vanilla RTS) / 1.4x (threaded RTS)"
    according to #8345
    
    Reviewed By: austin, simonmar
    
    Differential Revision: https://phabricator.haskell.org/D315


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

9e2cb00e5af9d86546f82a74c3d0382e65704d56
 libraries/base/Data/IORef.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/libraries/base/Data/IORef.hs b/libraries/base/Data/IORef.hs
index 0e5717c..2981805 100644
--- a/libraries/base/Data/IORef.hs
+++ b/libraries/base/Data/IORef.hs
@@ -106,9 +106,9 @@ atomicModifyIORef = GHC.IORef.atomicModifyIORef
 -- /Since: 4.6.0.0/
 atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b
 atomicModifyIORef' ref f = do
-    b <- atomicModifyIORef ref
-            (\x -> let (a, b) = f x
-                    in (a, a `seq` b))
+    b <- atomicModifyIORef ref $ \a ->
+            case f a of
+                v@(a',_) -> a' `seq` v
     b `seq` return b
 
 -- | Variant of 'writeIORef' with the \"barrier to reordering\" property that