[GHC] #14620: Polymorphic functions not easily recognized as join points

[GHC]

#14620: Polymorphic functions not easily recognized as join points
-------------------------------------+-------------------------------------
           Reporter:  dfeuer         |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:  8.6.1
          Component:  Compiler       |           Version:  8.2.2
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  Runtime
  Unknown/Multiple                   |  performance bug
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:  #14610
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 This grew out of ticket:14610#comment:3. 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. As Joachim
 Breitner's comments seem to suggest, we could probably recognize this by
 applying the static argument transformation to the type argument of `go`.
 But we don't currently have any machinery for doing that, I don't think.
 Furthermore, that would fail with polymorphic recursion even if the only
 type changes are from `newtype`. That said, the SAT approach would
 presumably help when the worker has a non-essential type signature for
 clarity.

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