[commit: ghc] wip/dfeuer-interleave-null: Speed up unsafeInterleaveIO (a53064e)

[git at git.haskell.org]

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

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

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

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

    Speed up unsafeInterleaveIO
    
    Summary:
    Use an `MVar` and a "null pointer" trick I learned from Edward
    Kmett to try to make `unsafeInterleaveIO` faster in the threaded
    runtime, where `noDuplicate#` is not always cheap.
    
    Reviewers: austin, hvr, bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3529


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

a53064ee44d398ba175fdca3bec551e7db62aa26
 libraries/base/GHC/IO/Unsafe.hs | 29 ++++++++++++++++++++++++++---
 1 file changed, 26 insertions(+), 3 deletions(-)

diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
index c1c07ae..376412b 100644
--- a/libraries/base/GHC/IO/Unsafe.hs
+++ b/libraries/base/GHC/IO/Unsafe.hs
@@ -26,7 +26,9 @@ module GHC.IO.Unsafe (
   ) where
 
 import GHC.Base
-
+import GHC.MVar
+import GHC.IORef
+import GHC.STRef
 
 {-|
 This is the \"back door\" into the 'IO' monad, allowing
@@ -111,12 +113,33 @@ file reading, see 'System.IO.hGetContents'.
 -}
 {-# INLINE unsafeInterleaveIO #-}
 unsafeInterleaveIO :: IO a -> IO a
-unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
+unsafeInterleaveIO m = do
+  v <- case unclaimed of
+         IORef (STRef r) -> unsafeCoerce# newMVar r
+  unsafeDupableInterleaveIO $ do
+  a <- takeMVar v
+  if isUnclaimed a
+    then do
+      res <- m
+      putMVar v res
+      pure res
+    else a <$ putMVar v a
+
+-- We use 'unclaimed' as a "null pointer" in 'unsafeInterleaveIO'.
+-- It must not be exported!
+{-# NOINLINE unclaimed #-}
+unclaimed :: IORef ()
+unclaimed = unsafePerformIO $ newIORef ()
+
+isUnclaimed :: a -> Bool
+isUnclaimed a = case unclaimed of
+  IORef (STRef r) -> isTrue# (unsafeCoerce# reallyUnsafePtrEquality# a r)
+
 
 -- 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.
 --