[commit: ghc] wip/T15578: Honor INLINE on 0-arity bindings (#15578) (036c82a)

[git at git.haskell.org]

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

On branch  : wip/T15578
Link       : http://ghc.haskell.org/trac/ghc/changeset/036c82a5acb3c7dfea928e0c75423d1a60dee158/ghc

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

commit 036c82a5acb3c7dfea928e0c75423d1a60dee158
Author: Tobias Dammers <tdammers at gmail.com>
Date:   Wed Sep 5 09:34:38 2018 +0200

    Honor INLINE on 0-arity bindings (#15578)


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

036c82a5acb3c7dfea928e0c75423d1a60dee158
 compiler/coreSyn/CoreUnfold.hs |  3 ++-
 compiler/simplCore/Simplify.hs | 16 +++++++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 68e7290..fe2ae62 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -159,7 +159,8 @@ mkInlineUnfoldingWithArity arity expr
     guide = UnfWhen { ug_arity = arity
                     , ug_unsat_ok = needSaturated
                     , ug_boring_ok = boring_ok }
-    boring_ok = inlineBoringOk expr'
+    boring_ok | arity == 0 = True
+              | otherwise  = inlineBoringOk expr'
 
 mkInlinableUnfolding :: DynFlags -> CoreExpr -> Unfolding
 mkInlinableUnfolding dflags expr
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index c8870c9..f2defcd 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -3402,14 +3402,24 @@ simplStableUnfolding env top_lvl mb_cont id unf rhs_ty
                            Just cont -> simplJoinRhs unf_env id expr cont
                            Nothing   -> simplExprC unf_env expr (mkBoringStop rhs_ty)
               ; case guide of
-                  UnfWhen { ug_arity = arity, ug_unsat_ok = sat_ok }  -- Happens for INLINE things
-                     -> let guide' = UnfWhen { ug_arity = arity, ug_unsat_ok = sat_ok
-                                             , ug_boring_ok = inlineBoringOk expr' }
+                  UnfWhen { ug_arity = arity
+                          , ug_unsat_ok = sat_ok
+                          , ug_boring_ok = boring_ok
+                          }
+                          -- Happens for INLINE things
+                     -> let guide' =
+                              UnfWhen { ug_arity = arity
+                                      , ug_unsat_ok = sat_ok
+                                      , ug_boring_ok =
+                                          boring_ok || inlineBoringOk expr'
+                                      }
                         -- Refresh the boring-ok flag, in case expr'
                         -- has got small. This happens, notably in the inlinings
                         -- for dfuns for single-method classes; see
                         -- Note [Single-method classes] in TcInstDcls.
                         -- A test case is Trac #4138
+                        -- But retain a previous boring_ok of True; e.g. see
+                        -- the way it is set in calcUnfoldingGuidanceWithArity
                         in return (mkCoreUnfolding src is_top_lvl expr' guide')
                             -- See Note [Top-level flag on inline rules] in CoreUnfold