[commit: ghc] wip/T14068: If there is a artificial no-inline-pragma, do not bother creating an unfolding (1d81171)

[git at git.haskell.org]

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

On branch  : wip/T14068
Link       : http://ghc.haskell.org/trac/ghc/changeset/1d811710f9681693f3dcdd647a1231dcebc8bce1/ghc

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

commit 1d811710f9681693f3dcdd647a1231dcebc8bce1
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Mon Nov 6 15:14:11 2017 -0500

    If there is a artificial no-inline-pragma, do not bother creating an unfolding


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

1d811710f9681693f3dcdd647a1231dcebc8bce1
 compiler/basicTypes/BasicTypes.hs | 8 +++++++-
 compiler/simplCore/Simplify.hs    | 4 +++-
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index a866153..3e5fbfe 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -88,7 +88,7 @@ module BasicTypes(
         InlineSpec(..), noUserInlineSpec,
         InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
         neverInlinePragma, dfunInlinePragma,
-        isDefaultInlinePragma,
+        isDefaultInlinePragma, isNeverInlinePragma,
         isInlinePragma, isInlinablePragma, isAnyInlinePragma,
         inlinePragmaSpec, inlinePragmaSat,
         inlinePragmaActivation, inlinePragmaRuleMatchInfo,
@@ -1352,6 +1352,12 @@ isDefaultInlinePragma (InlinePragma { inl_act = activation
                                     , inl_inline = inline })
   = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info
 
+isNeverInlinePragma :: InlinePragma -> Bool
+isNeverInlinePragma (InlinePragma { inl_act = activation
+                                  , inl_rule = match_info
+                                  , inl_inline = inline })
+  = noUserInlineSpec inline && isNeverActive activation && isFunLike match_info
+
 isInlinePragma :: InlinePragma -> Bool
 isInlinePragma prag = case inl_inline prag of
                         Inline -> True
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 532b7ee..b576e8a 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -41,7 +41,7 @@ import CoreOpt          ( pushCoTyArg, pushCoValArg
 import Rules            ( mkRuleInfo, lookupRule, getRules )
 import Demand           ( mkClosedStrictSig, topDmd, exnRes )
 import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel,
-                          RecFlag(..), Arity )
+                          RecFlag(..), Arity, isNeverInlinePragma )
 import MonadUtils       ( mapAccumLM, liftIO )
 import Maybes           (  orElse )
 import Control.Monad
@@ -3263,6 +3263,8 @@ simplLetUnfolding env top_lvl cont_mb id new_rhs unf
   = simplStableUnfolding env top_lvl cont_mb id unf
   | isExitJoinId id
   = return noUnfolding -- see Note [Do not inline exit join points]
+  | isNeverInlinePragma (idInlinePragma id)
+  = return noUnfolding -- Do not bother creating one if we never inline anyways
   | otherwise
   = mkLetUnfolding (seDynFlags env) top_lvl InlineRhs id new_rhs