[commit: ghc] wip/llf: only stabilize if TidyPgm would retain the unfolding (4d3f37e)

[git at git.haskell.org]

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

On branch  : wip/llf
Link       : http://ghc.haskell.org/trac/ghc/changeset/4d3f37e0c07f35be51b8bb24374ca3163b8b9a46/ghc

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

commit 4d3f37e0c07f35be51b8bb24374ca3163b8b9a46
Author: Nicolas Frisby <nicolas.frisby at gmail.com>
Date:   Tue Aug 19 19:51:21 2014 -0500

    only stabilize if TidyPgm would retain the unfolding


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

4d3f37e0c07f35be51b8bb24374ca3163b8b9a46
 compiler/main/TidyPgm.lhs        |  3 ++-
 compiler/simplCore/SetLevels.lhs | 15 ++++++++++-----
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index b20658b..97ad171 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -5,7 +5,8 @@
 
 \begin{code}
 module TidyPgm (
-       mkBootModDetailsTc, tidyProgram, globaliseAndTidyId
+       mkBootModDetailsTc, tidyProgram, globaliseAndTidyId,
+       addExternal
    ) where
 
 #include "HsVersions.h"
diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 09d69e4..fc1e4df 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -84,6 +84,8 @@ import StgCmmArgRep     ( ArgRep(P), argRepSizeW, toArgRep )
 import StgCmmLayout     ( mkVirtHeapOffsets )
 import StgCmmClosure    ( idPrimRep, addIdReps )
 
+import qualified TidyPgm
+
 import Demand           ( isStrictDmd, splitStrictSig )
 import Id
 import IdInfo
@@ -260,13 +262,16 @@ lvlTopBind :: DynFlags -> LevelEnv -> Bind Id -> LvlM (LevelledBind, LevelEnv)
 lvlTopBind dflags env (NonRec bndr rhs)
   = do { rhs' <- lvlExpr env (analyzeFVs (initFVEnv $ finalPass env) rhs)
        ; let  -- lambda lifting impedes specialization, so: if the old
-              -- RHS has an unstable unfolding, "stablize it" so that it
-              -- ends up in the .hi file
+              -- RHS has an unstable unfolding that will survive
+              -- TidyPgm, "stablize it" so that it ends up in the .hi
+              -- file as-is, prior to LLF squeezing all of the juice out
+              expose_all = gopt Opt_ExposeAllUnfoldings  dflags
               stab_bndr
-                | gopt Opt_LLF_Stabilize dflags
-                , isFinalPass env
+                | isFinalPass env
+                , gopt Opt_LLF_Stabilize dflags
+                , snd $ TidyPgm.addExternal expose_all bndr
                 , isUnstableUnfolding (realIdUnfolding bndr)
-                = bndr `setIdUnfolding` mkInlinableUnfolding dflags rhs
+                  = bndr `setIdUnfolding` mkInlinableUnfolding dflags rhs
                 | otherwise = bndr
        ; let (env', [bndr']) = substAndLvlBndrs NonRecursive env tOP_LEVEL [stab_bndr]
        ; return (NonRec bndr' rhs', env') }