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

[git at git.haskell.org]

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

On branch  : wip/T15578
Link       : http://ghc.haskell.org/trac/ghc/changeset/2d416cd8c3d1a0657bf444a248b6082cfb7c9e32/ghc

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

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

    Honor INLINE on 0-arity bindings (#15578)


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

2d416cd8c3d1a0657bf444a248b6082cfb7c9e32
 compiler/coreSyn/CoreUnfold.hs      |   3 ++-
 compiler/simplCore/.Simplify.hs.swp | Bin 0 -> 172032 bytes
 compiler/simplCore/Simplify.hs      |  16 +++++++++++++---
 3 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.swp b/compiler/simplCore/.Simplify.hs.swp
new file mode 100644
index 0000000..91b3394
Binary files /dev/null and b/compiler/simplCore/.Simplify.hs.swp differ
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