[commit: ghc] master: Add strictness for runRW# (f3cc345)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f3cc34568b13abb29de7b54a5f657681e9e116ca/ghc

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

commit f3cc34568b13abb29de7b54a5f657681e9e116ca
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Dec 31 22:25:31 2015 +0000

    Add strictness for runRW#
    
    runRW# isn't inlined until CorePrep, so it's good to expose its
    strictness.  Moreover, if we don't we can get obscure failures
    in coreToStg; see Note [runRW arg] in CorePrep.
    
    This fixes Trac #11291, and makes DfltProb1 compile with -O
    always in order to expose it more vigorously


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

f3cc34568b13abb29de7b54a5f657681e9e116ca
 compiler/basicTypes/MkId.hs                    |  9 ++++++++-
 compiler/coreSyn/CorePrep.hs                   | 12 ++++++++++++
 testsuite/tests/typecheck/should_compile/all.T |  3 ++-
 3 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index f690732..f796d76 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -1179,7 +1179,14 @@ oneShotId = pcMiscPrelId oneShotName ty info
 runRWId :: Id -- See Note [runRW magic] in this module
 runRWId = pcMiscPrelId runRWName ty info
   where
-    info    = noCafIdInfo `setInlinePragInfo` neverInlinePragma
+    info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
+                       `setStrictnessInfo` strict_sig
+                       `setArityInfo`      1
+    strict_sig = mkClosedStrictSig [strictApply1Dmd] topRes
+      -- Important to express its strictness,
+      -- since it is not inlined until CorePrep
+      -- Also see Note [runRW arg] in CorePrep
+
     -- State# RealWorld
     stateRW = mkTyConApp statePrimTyCon [realWorldTy]
     -- (# State# RealWorld, o #)
diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs
index adaad61..df18f8b 100644
--- a/compiler/coreSyn/CorePrep.hs
+++ b/compiler/coreSyn/CorePrep.hs
@@ -518,6 +518,18 @@ cpeRhsE env (Var f `App` _levity `App` _type `App` arg)
   = case arg of                   -- beta reducing if possible
       Lam s body -> cpeRhsE (extendCorePrepEnv env s realWorldPrimId) body
       _          -> cpeRhsE env (arg `App` Var realWorldPrimId)
+                    -- See Note [runRW arg]
+
+{- Note [runRW arg]
+~~~~~~~~~~~~~~~~~~~
+If we got, say
+   runRW# (case bot of {})
+which happened in Trac #11291, we do /not/ want to turn it into
+   (case bot of {}) realWorldPrimId#
+because that gives a panic in CoreToStg.myCollectArgs, which expects
+only variables in function position.  But if we are sure to make
+runRW# strict (which we do in MkId), this can't happen
+-}
 
 cpeRhsE env expr@(App {}) = cpeApp env expr
 
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 3fa1f8c..0c1d0c1 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -383,7 +383,8 @@ test('T5792',normal,run_command,
 test('PolytypeDecomp', normal, compile, [''])
 test('T6011', normal, compile, [''])
 test('T6055', normal, compile, [''])
-test('DfltProb1', normal, compile, [''])
+test('DfltProb1', normal, compile, ['-O'])
+# Add -O for DfltProb1 to expose Trac #11291
 test('DfltProb2', normal, compile, [''])
 test('T6134', normal, compile, [''])
 test('T6018', extra_clean(['T6018.hi' , 'T6018.o'