[GHC] #14610: newtype wrapping of a monadic stack kills performance

[GHC]

#14610: newtype wrapping of a monadic stack kills performance
-------------------------------------+-------------------------------------
        Reporter:  mrkkrp            |                Owner:  (none)
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  8.2.2
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by dfeuer):

 I haven't yet been able to reproduce quite the same behavior, but this
 small example looks like it could be related. If I write

 {{{#!hs
 foo :: forall a. (Int -> Bool) -> Int -> a -> a
 foo p = go
   where
     go :: Int -> a -> a
     go !n a
       | p n = a
       | otherwise = go (n + 1) a
 }}}

 then I get

 {{{
 foo
   = \ (@ a_aYZ)
       (p_aWO :: Int -> Bool)
       (eta_B2 :: Int)
       (eta1_B1 :: a_aYZ) ->
       case eta_B2 of { GHC.Types.I# ww1_s1bZ ->
       joinrec {
         $wgo_s1c1 [InlPrag=NOUSERINLINE[0], Occ=LoopBreaker]
           :: GHC.Prim.Int# -> a_aYZ -> a_aYZ
         [LclId[JoinId(2)], Arity=2, Str=<L,U><S,1*U>, Unf=OtherCon []]
         $wgo_s1c1 (ww2_X1cu :: GHC.Prim.Int#) (w_s1bW :: a_aYZ)
           = case p_aWO (GHC.Types.I# ww2_X1cu) of {
               False -> jump $wgo_s1c1 (GHC.Prim.+# ww2_X1cu 1#) w_s1bW;
               True -> w_s1bW
             }; } in
       jump $wgo_s1c1 ww1_s1bZ eta1_B1
       }
 }}}

 But if I make `go` polymorphic,

 {{{#!hs
 foo :: (Int -> Bool) -> Int -> a -> a
 foo p = go
   where
     go :: Int -> b -> b
     go !n a
       | p n = a
       | otherwise = go (n + 1) a
 }}}

 I get a wrapper and this worker:

 {{{#!hs
 T14610.$wfoo
   = \ (@ a_s1cm)
       (w_s1cn :: Int -> Bool)
       (ww_s1cs :: GHC.Prim.Int#)
       (w1_s1cp :: a_s1cm) ->
       letrec {
         $wgo_s1cl [InlPrag=NOUSERINLINE[0], Occ=LoopBreaker]
           :: forall b. GHC.Prim.Int# -> b -> b
         [LclId, Arity=2, Str=<L,U><S,1*U>, Unf=OtherCon []]
         $wgo_s1cl
           = \ (@ b_s1ce) (ww1_s1cj :: GHC.Prim.Int#) (w2_s1cg :: b_s1ce)
 ->
               case w_s1cn (GHC.Types.I# ww1_s1cj) of {
                 False -> $wgo_s1cl @ b_s1ce (GHC.Prim.+# ww1_s1cj 1#)
 w2_s1cg;
                 True -> w2_s1cg
               }; } in
       $wgo_s1cl @ a_s1cm ww_s1cs w1_s1cp
 }}}

 This distinction remains as `let` vs. `let-no-escape` in STG.

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