[commit: ghc] wip/dfeuer-interleave-mvars: Switch to single-MVar unsafeInterleaveIO (aed2d85)

[git at git.haskell.org]

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

On branch  : wip/dfeuer-interleave-mvars
Link       : http://ghc.haskell.org/trac/ghc/changeset/aed2d85f5deacc0e9b0500eb5b1095643e536581/ghc

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

commit aed2d85f5deacc0e9b0500eb5b1095643e536581
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed May 3 09:47:32 2017 -0400

    Switch to single-MVar unsafeInterleaveIO
    
    Ben Gamari has pointed out that using two `MVar`s may be reducing
    efficiency. Let's see what happens with an `MVar . Maybe` approach.
    The next potential stage is to switch from `Maybe` to null pointers.


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

aed2d85f5deacc0e9b0500eb5b1095643e536581
 libraries/base/GHC/IO/Unsafe.hs | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
index 5498e19..3c958c1 100644
--- a/libraries/base/GHC/IO/Unsafe.hs
+++ b/libraries/base/GHC/IO/Unsafe.hs
@@ -112,18 +112,29 @@ file reading, see 'System.IO.hGetContents'.
 {-# INLINE unsafeInterleaveIO #-}
 unsafeInterleaveIO :: IO a -> IO a
 unsafeInterleaveIO m = do
-  claimedV <- newEmptyMVar
-  resultV <- newEmptyMVar
+  v <- newMVar Nothing
   unsafeDupableInterleaveIO $ do
-    claimSucceeded <- tryPutMVar claimedV ()
-    if claimSucceeded
-      then do
-             -- We were the first ones to claim the computation, so we
-             -- perform it and store the result.
-             res <- m
-             putMVar resultV res
-             pure res
-      else readMVar resultV
+    r <- tryTakeMVar v
+    case r of
+      -- Someone else has taken the MVar. By the time they put
+      -- it back, the action will surely have been performed,
+      -- so we use the result.
+      Nothing -> do
+        res <- readMVar v
+        case res of
+          Nothing -> errorWithoutStackTrace "unsafeInterleaveIO: impossible Nothing"
+          Just a -> pure a
+
+      -- Someone else has performed the action, so we use
+      -- their result and put it back in the MVar.
+      Just j@(Just r) -> r <$ putMVar v j
+
+      -- We're the first ones to get the MVar, so we actually
+      -- do the work.
+      Just Nothing -> do
+        res <- m
+        putMVar v (Just res)
+        pure res
 
 
 -- Note [unsafeDupableInterleaveIO should not be inlined]