[commit: ghc] master: Never apply worker/wrapper to DFuns (c48595e)

[git at git.haskell.org]

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

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

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

commit c48595eef2bca6d91ec0a649839f8066f269e6a4
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Dec 21 12:22:00 2016 +0000

    Never apply worker/wrapper to DFuns
    
    While fixing Trac #12444 I found an occasion on which we applied
    worker/wrapper to a DFunId.  This is bad: it destroys the magic
    DFunUnfolding.
    
    This patch is a minor refactoring that stops this corner case
    happening, and tidies up the code a bit too.


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

c48595eef2bca6d91ec0a649839f8066f269e6a4
 compiler/coreSyn/CoreUnfold.hs | 74 ++++++++++++++++++++++++------------------
 compiler/stranal/WorkWrap.hs   | 10 ++----
 2 files changed, 46 insertions(+), 38 deletions(-)

diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 7faee63..a601539 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -944,40 +944,52 @@ smallEnoughToInline _ _
   = False
 
 ----------------
-certainlyWillInline :: DynFlags -> Unfolding -> Maybe Unfolding
+
+certainlyWillInline :: DynFlags -> IdInfo -> Maybe Unfolding
 -- Sees if the unfolding is pretty certain to inline
 -- If so, return a *stable* unfolding for it, that will always inline
-certainlyWillInline dflags unf@(CoreUnfolding { uf_guidance = guidance, uf_tmpl = expr })
-  = case guidance of
-      UnfNever   -> Nothing
-      UnfWhen {} -> Just (unf { uf_src = InlineStable })
-
-      -- The UnfIfGoodArgs case seems important.  If we w/w small functions
-      -- binary sizes go up by 10%!  (This is with SplitObjs.)  I'm not totally
-      -- sure whyy.
-      UnfIfGoodArgs { ug_size = size, ug_args = args }
-         | not (null args)  -- See Note [certainlyWillInline: be careful of thunks]
-         , let arity = length args
-         , size - (10 * (arity + 1)) <= ufUseThreshold dflags
-         -> Just (unf { uf_src      = InlineStable
-                      , uf_guidance = UnfWhen { ug_arity     = arity
-                                              , ug_unsat_ok  = unSaturatedOk
-                                              , ug_boring_ok = inlineBoringOk expr } })
-                -- Note the "unsaturatedOk". A function like  f = \ab. a
-                -- will certainly inline, even if partially applied (f e), so we'd
-                -- better make sure that the transformed inlining has the same property
-
-      _  -> Nothing
-
-certainlyWillInline _ unf@(DFunUnfolding {})
-  = Just unf
-
-certainlyWillInline _ _
-  = Nothing
+certainlyWillInline dflags fn_info
+  = case unfoldingInfo fn_info of
+      CoreUnfolding { uf_tmpl = e, uf_guidance = g }
+        | loop_breaker -> Nothing       -- Won't inline, so try w/w
+        | otherwise    -> do_cunf e g   -- Depends on size, so look at that
 
-{-
-Note [certainlyWillInline: be careful of thunks]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+      DFunUnfolding {} -> Just fn_unf  -- Don't w/w DFuns; it never makes sense
+                                       -- to do so, and even if it is currently a
+                                       -- loop breaker, it may not be later
+
+      _other_unf       -> Nothing
+
+  where
+    loop_breaker = isStrongLoopBreaker (occInfo fn_info)
+    fn_unf       = unfoldingInfo fn_info
+
+    do_cunf :: CoreExpr -> UnfoldingGuidance -> Maybe Unfolding
+    do_cunf _ UnfNever     = Nothing
+    do_cunf _ (UnfWhen {}) = Just (fn_unf { uf_src = InlineStable })
+                             -- INLINE functions have UnfWhen
+
+        -- The UnfIfGoodArgs case seems important.  If we w/w small functions
+        -- binary sizes go up by 10%!  (This is with SplitObjs.)
+        -- I'm not totally sure why.
+        -- INLINABLE functions come via this path
+        --    See Note [certainlyWillInline: INLINABLE]
+    do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args })
+      | not (null args)  -- See Note [certainlyWillInline: be careful of thunks]
+      , let arity = length args
+      , size - (10 * (arity + 1)) <= ufUseThreshold dflags
+      = Just (fn_unf { uf_src      = InlineStable
+                     , uf_guidance = UnfWhen { ug_arity     = arity
+                                             , ug_unsat_ok  = unSaturatedOk
+                                             , ug_boring_ok = inlineBoringOk expr } })
+             -- Note the "unsaturatedOk". A function like  f = \ab. a
+             -- will certainly inline, even if partially applied (f e), so we'd
+             -- better make sure that the transformed inlining has the same property
+      | otherwise
+      = Nothing
+
+{- Note [certainlyWillInline: be careful of thunks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Don't claim that thunks will certainly inline, because that risks work
 duplication.  Even if the work duplication is not great (eg is_cheap
 holds), it can make a big difference in an inner loop In Trac #5623 we
diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs
index 2db3a71..d50bb22 100644
--- a/compiler/stranal/WorkWrap.hs
+++ b/compiler/stranal/WorkWrap.hs
@@ -289,12 +289,10 @@ tryWW dflags fam_envs is_rec fn_id rhs
         -- being inlined at a call site.
   = return [ (new_fn_id, rhs) ]
 
-  | not loop_breaker
-  , Just stable_unf <- certainlyWillInline dflags fn_unf
+  | Just stable_unf <- certainlyWillInline dflags fn_info
   = return [ (fn_id `setIdUnfolding` stable_unf, rhs) ]
-        -- Note [Don't w/w inline small non-loop-breaker, or INLINE, things]
-        -- NB: use idUnfolding because we don't want to apply
-        --     this criterion to a loop breaker!
+        -- See Note [Don't w/w INLINE things]
+        -- See Note [Don't w/w inline small non-loop-breaker things]
 
   | is_fun
   = splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs
@@ -306,10 +304,8 @@ tryWW dflags fam_envs is_rec fn_id rhs
   = return [ (new_fn_id, rhs) ]
 
   where
-    loop_breaker = isStrongLoopBreaker (occInfo fn_info)
     fn_info      = idInfo fn_id
     inline_act   = inlinePragmaActivation (inlinePragInfo fn_info)
-    fn_unf       = unfoldingInfo fn_info
     (wrap_dmds, res_info) = splitStrictSig (strictnessInfo fn_info)
 
     new_fn_id = zapIdUsedOnceInfo (zapIdUsageEnvInfo fn_id)