[commit: ghc] wip/dfeuer-interleave-mvars: Implement unsafeInterleaveIO using MVars (fdd659b)

[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/fdd659bf85617983c2a3da16a5ceb28a16f65cf9/ghc

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

commit fdd659bf85617983c2a3da16a5ceb28a16f65cf9
Author: David Feuer <David.Feuer at gmail.com>
Date:   Tue May 2 17:09:00 2017 -0400

    Implement unsafeInterleaveIO using MVars
    
    Summary:
    Previously, `unsafeInterleaveIO` used `noDuplicate` to prevent the
    computation from being run twice. `noDuplicate` needs to walk the
    evaluation stack. This experimental implementation instead uses
    `MVar`s to prevent duplication.
    
    Reviewers: austin, hvr, bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3526


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

fdd659bf85617983c2a3da16a5ceb28a16f65cf9
 libraries/base/GHC/IO/Unsafe.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
index c1c07ae..5498e19 100644
--- a/libraries/base/GHC/IO/Unsafe.hs
+++ b/libraries/base/GHC/IO/Unsafe.hs
@@ -26,7 +26,7 @@ module GHC.IO.Unsafe (
   ) where
 
 import GHC.Base
-
+import GHC.MVar
 
 {-|
 This is the \"back door\" into the 'IO' monad, allowing
@@ -111,12 +111,25 @@ file reading, see 'System.IO.hGetContents'.
 -}
 {-# INLINE unsafeInterleaveIO #-}
 unsafeInterleaveIO :: IO a -> IO a
-unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
+unsafeInterleaveIO m = do
+  claimedV <- newEmptyMVar
+  resultV <- newEmptyMVar
+  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
+
 
 -- Note [unsafeDupableInterleaveIO should not be inlined]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
--- We used to believe that INLINE on unsafeInterleaveIO was safe,
+-- We used to believe that INLINE on unsafeDupableInterleaveIO was safe,
 -- because the state from this IO thread is passed explicitly to the
 -- interleaved IO, so it cannot be floated out and shared.
 --