Switch to single-MVar unsafeInterleaveIOwip/dfeuer-interleave-mvars

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.

1 files changed, 22 insertions, 11 deletions

diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
index 5498e19c95..3c958c1b84 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]