[Git][ghc/ghc][wip/inline-unsafeDupableInterleaveIO] Allow unsafeDupableInterleaveIO to inline

[Matthew Craven (@clyring)]

Matthew Craven pushed to branch wip/inline-unsafeDupableInterleaveIO at Glasgow Haskell Compiler / GHC


Commits:
1d0136eb by Matthew Craven at 2024-01-15T18:37:32-05:00
Allow unsafeDupableInterleaveIO to inline

This requires preventing unsafeInterleaveIO from inlining,
for reasons described in the relevant Note, which has been
renamed and updated.

- - - - -


6 changed files:

- libraries/base/src/GHC/IO/Unsafe.hs
- libraries/base/src/GHC/ST.hs
- + libraries/base/tests/T5859.hs
- + libraries/base/tests/T5859.stdout
- libraries/base/tests/all.T
- testsuite/tests/lib/base/all.T


Changes:

=====================================
libraries/base/src/GHC/IO/Unsafe.hs
=====================================
@@ -150,29 +150,28 @@ When passed a value of type @IO a@, the 'IO' will only be performed
 when the value of the @a@ is demanded.  This is used to implement lazy
 file reading, see 'System.IO.hGetContents'.
 -}
-{-# INLINE unsafeInterleaveIO #-}
+{-# NOINLINE unsafeInterleaveIO #-}
+-- See Note [unsafeInterleaveIO should not be inlined]
 unsafeInterleaveIO :: IO a -> IO a
 unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
 
--- Note [unsafeDupableInterleaveIO should not be inlined]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Note [unsafeInterleaveIO should not be inlined]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 --
 -- We used to believe that INLINE on unsafeInterleaveIO was safe,
 -- because the state from this IO thread is passed explicitly to the
 -- interleaved IO, so it cannot be floated out and shared.
 --
--- HOWEVER, if the compiler figures out that r is used strictly here,
--- then it will eliminate the thunk and the side effects in m will no
--- longer be shared in the way the programmer was probably expecting,
--- but can be performed many times.  In #5943, this broke our
--- definition of fixIO, which contains
+-- HOWEVER, due to the state hack (on by default), the compiler may
+-- float the key thunk 'r' from unsafeDupableInterleaveIO into a
+-- counterfeit one-shot lambda, thus duplicating it.  Or it may just
+-- wrongly conclude that the thunk is single-entry, which might keep
+-- noDuplicate# from working since that looks for update frames on the
+-- stack. This came up in #5859, and in #5943 this broke our
+-- definition of fixIO, which at the time contained
 --
 --    ans <- unsafeInterleaveIO (takeMVar m)
 --
--- after inlining, we lose the sharing of the takeMVar, so the second
--- time 'ans' was demanded we got a deadlock.  We could fix this with
--- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes
--- share and sometimes not (plus it probably breaks the noDuplicate).
 -- So now, we do not inline unsafeDupableInterleaveIO.
 
 {-|
@@ -184,9 +183,6 @@ The computation may be performed multiple times by different threads,
 possibly at the same time. To ensure that the computation is performed
 only once, use 'unsafeInterleaveIO' instead.
 -}
-
-{-# NOINLINE unsafeDupableInterleaveIO #-}
--- See Note [unsafeDupableInterleaveIO should not be inlined]
 unsafeDupableInterleaveIO :: IO a -> IO a
 unsafeDupableInterleaveIO (IO m)
   = IO ( \ s -> let


=====================================
libraries/base/src/GHC/ST.hs
=====================================
@@ -97,7 +97,8 @@ noDuplicateST = ST $ \s -> (# noDuplicate# s, () #)
 -- | 'unsafeInterleaveST' allows an 'ST' computation to be deferred
 -- lazily.  When passed a value of type @ST a@, the 'ST' computation will
 -- only be performed when the value of the @a@ is demanded.
-{-# INLINE unsafeInterleaveST #-}
+{-# NOINLINE unsafeInterleaveST #-}
+-- See Note [unsafeInterleaveIO should not be inlined] in GHC.IO.Unsafe
 unsafeInterleaveST :: ST s a -> ST s a
 unsafeInterleaveST m = unsafeDupableInterleaveST (noDuplicateST >> m)
 
@@ -109,9 +110,6 @@ unsafeInterleaveST m = unsafeDupableInterleaveST (noDuplicateST >> m)
 -- possibly at the same time. To prevent this, use 'unsafeInterleaveST' instead.
 --
 -- @since 4.11
-{-# NOINLINE unsafeDupableInterleaveST #-}
--- See Note [unsafeDupableInterleaveIO should not be inlined]
--- in GHC.IO.Unsafe
 unsafeDupableInterleaveST :: ST s a -> ST s a
 unsafeDupableInterleaveST (ST m) = ST ( \ s ->
     let


=====================================
libraries/base/tests/T5859.hs
=====================================
@@ -0,0 +1,12 @@
+import Control.Concurrent
+import Control.Exception (evaluate)
+import Control.Monad
+import System.IO.Unsafe
+
+main :: IO ()
+main = do
+  x <- unsafeInterleaveIO $ putStrLn "eval"
+  -- Since this is 'unsafeInterleaveIO' and not 'unsafeDupableInterleaveIO',
+  -- this program must print "eval" only once
+  replicateM_ 1000 $ forkIO $ evaluate x >> return ()
+  threadDelay 1000000


=====================================
libraries/base/tests/T5859.stdout
=====================================
@@ -0,0 +1 @@
+eval


=====================================
libraries/base/tests/all.T
=====================================
@@ -1,3 +1,5 @@
+# See also the tests in testsuite/tests/lib/base/
+
 import string
 import re
 
@@ -163,7 +165,11 @@ test('T2528', normal, compile_and_run, [''])
 #     so let's normalise the output.
 test('T4006', [normalise_fun(normalise_quotes), req_process], compile_and_run, [''])
 
-test('T5943', normal, compile_and_run, [''])
+# These two tests should have "-fstate-hack" (to be explicit),
+# but that flag apparently doesn't exist for some reason
+test('T5859', normal, compile_and_run, ['-O'])
+test('T5943', normal, compile_and_run, ['-O'])
+
 test('T5962', normal, compile_and_run, [''])
 test('T7034', normal, compile_and_run, [''])
 


=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -1,3 +1,5 @@
+# See also the tests in libraries/base/tests/
+
 test('DataTypeOrd', normal, compile_and_run, [''])
 test('T16586', normal, compile_and_run, ['-O2'])
 # Event-manager not supported on Windows



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d0136eb2746c81161386722e34b0ba8733f89e7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d0136eb2746c81161386722e34b0ba8733f89e7
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240115/45887658/attachment-0001.html>