[GHC] #15578: Honour INLINE pragmas on 0-arity bindings

[GHC]

#15578: Honour INLINE pragmas on 0-arity bindings
-------------------------------------+-------------------------------------
        Reporter:  simonpj           |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.4.3
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #15519            |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by simonpj):

 OK here's a better patch
 {{{
 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..b0f6455 100644
 --- a/compiler/simplCore/Simplify.hs
 +++ b/compiler/simplCore/Simplify.hs
 @@ -3402,14 +3402,18 @@ 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
 +                  UnfWhen { ug_arity = arity, ug_unsat_ok = sat_ok
 +                          , ug_boring_ok = boring_ok }
 +                     -- This branch happens for INLINE things
                       -> let guide' = UnfWhen { ug_arity = arity,
 ug_unsat_ok = sat_ok
 -                                             , ug_boring_ok =
 inlineBoringOk expr' }
 +                                             , 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 don't forget a 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
 }}}
 I'd forgotten about the bit in `Simplify`.

 Moreover, you do need
 {{{
 test3 = oneShot (runTokenParser testGrammar1)
 }}}
 Then I think we get good perf.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15578#comment:10>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler