Make unsafeDupablePerformIO have a lazy demandwip/andreask/runRW_fix

When a user writes code like:

    unsafePerformIO $ do
        let x = f x
        writeIORef ref x
        return x

We might expect that the write happens before we evaluate `f x`.
Sadly this wasn't to case for reasons detailed in #19181.

We fix this by avoiding the strict demand by turning:

    unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a

into

    unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> lazy a

This makes the above code lazy in x. And ensures the side effect of the
write happens before the evaluation of `f x`. If a user *wants* the code
to be strict on the returned value he can simply use `return $! x`.

This fixes #19181

2 files changed, 44 insertions, 35 deletions

diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 0d7d8c219b..3eb86852ac 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -1295,42 +1295,16 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id
     main_ty = addDemand dmd dmd_ty'
     (dmd_ty', dmd) = findBndrDmd env arg_of_dfun dmd_ty id
 
-{-
-Note [NOINLINE and strictness]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The strictness analyser used to have a HACK which ensured that NOINLNE
-things were not strictness-analysed.  The reason was unsafePerformIO.
-Left to itself, the strictness analyser would discover this strictness
-for unsafePerformIO:
-        unsafePerformIO:  C(U(AV))
-But then consider this sub-expression
-        unsafePerformIO (\s -> let r = f x in
-                               case writeIORef v r s of (# s1, _ #) ->
-                               (# s1, r #)
-The strictness analyser will now find that r is sure to be eval'd,
-and may then hoist it out.  This makes tests/lib/should_run/memo002
-deadlock.
-
-Solving this by making all NOINLINE things have no strictness info is overkill.
-In particular, it's overkill for runST, which is perfectly respectable.
-Consider
-        f x = runST (return x)
-This should be strict in x.
-
-So the new plan is to define unsafePerformIO using the 'lazy' combinator:
-
-        unsafePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
+{- Note [NOINLINE and strictness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+At one point we disabled strictness for NOINLINE functions, on the
+grounds that they should be entirely opaque.  But that lost lots of
+useful semantic strictness information, so now we analyse them like
+any other function, and pin strictness information on them.
 
-Remember, 'lazy' is a wired-in identity-function Id, of type a->a, which is
-magically NON-STRICT, and is inlined after strictness analysis.  So
-unsafePerformIO will look non-strict, and that's what we want.
+That in turn forces us to worker/wrapper them; see
+Note [Worker-wrapper for NOINLINE functions] in GHC.Core.Opt.WorkWrap.
 
-Now we don't need the hack in the strictness analyser.  HOWEVER, this
-decision does mean that even a NOINLINE function is not entirely
-opaque: some aspect of its implementation leaks out, notably its
-strictness.  For example, if you have a function implemented by an
-error stub, but which has RULES, you may want it not to be eliminated
-in favour of error!
 
 Note [Lazy and unleashable free variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/libraries/base/GHC/IO/Unsafe.hs b/libraries/base/GHC/IO/Unsafe.hs
index 6e0ebc4ecf..9dfaaa1e2f 100644
--- a/libraries/base/GHC/IO/Unsafe.hs
+++ b/libraries/base/GHC/IO/Unsafe.hs
@@ -27,6 +27,40 @@ module GHC.IO.Unsafe (
 
 import GHC.Base
 
+{- Note [unsafePerformIO and strictness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this sub-expression (from tests/lib/should_run/memo002)
+
+ unsafePerformIO (do { lockMemoTable
+                     ; let r = f x
+                     ; updateMemoTable x r
+                     ; unlockMemoTable
+                     ; return r })
+
+It's super-important that the `let r = f x` is lazy. If the demand
+analyser sees that `r` is sure to be demanded, it'll use call-by-value
+for (f x), that will try to lock the already-locked table => deadlock.
+See #19181.
+
+Now `r` doesn't look strict, because it's wrapped in a `return`.
+But if we were to define unsafePerformIO like this
+  unsafePerformIO (IO m) = case runRW# m of (# _, r #) -> r
+
+then we'll push that `case` inside the arugment to runRW#, givign
+  runRW# (\s -> case lockMemoTable s of s1 ->
+                let r = f x in
+                case updateMemoTable s1 of s2 ->
+                case unlockMemoTable s2 of _ ->
+                r)
+
+And now that `let` really does look strict.  No good!
+
+Solution: wrap the result of the unsafePerformIO in 'lazy', to conceal
+it from the demand analyser:
+  unsafePerformIO (IO m) = case runRW# m of (# _, r #) -> lazy r
+                                                 ------>  ^^^^
+See also Note [lazyId magic] in GHC.Types.Id.Make
+-}
 
 {-|
 This is the \"back door\" into the 'IO' monad, allowing
@@ -102,7 +136,8 @@ like 'Control.Exception.bracket' cannot be used safely within
 @since 4.4.0.0
 -}
 unsafeDupablePerformIO  :: IO a -> a
-unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a
+-- See Note [unsafePerformIO and strictness]
+unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> lazy a
 
 {-|
 'unsafeInterleaveIO' allows an 'IO' computation to be deferred lazily.