[GHC] #11272: Overloaded state-monadic function is not specialised

[GHC]

#11272: Overloaded state-monadic function is not specialised
-------------------------------------+-------------------------------------
        Reporter:  NickSmallbone     |                Owner:
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:
       Component:  Compiler          |              Version:  7.10.3
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Runtime           |  Unknown/Multiple
  performance bug                    |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by simonpj):

 That is terrible.  I understand what is happening.

 * Since `overloaded` is recursive you must have an INLINEABLE pragma to
 have a chance of specialising it in an importing module

 * Sadly, when compiling A.hs with `{-# INLINEABLE overloaded #-}` I see a
 mutually recursive group of two functions:
 {{{
 Rec {
 -- RHS size: {terms: 15, types: 14, coercions: 4}
 T11272a.$woverloaded [InlPrag=INLINABLE[0], Occ=LoopBreaker]
   :: forall a_arY. Ord a_arY => a_arY -> a_arY -> () -> (# (), () #)
 [GblId,
  Arity=4,
  Caf=NoCafRefs,
  Str=DmdType
 <S(LLLC(C(S))LLLL),U(A,A,A,C(C1(U)),A,A,A,A)><L,U><L,U><S,1*H>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
          WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 0 0 20] 120
 30
          Tmpl= \ (@ a8_Xst)
                  (w_X1Me :: Ord a8_Xst)
                  (w1_X1Mg :: a8_Xst)
                  (w2_X1Mi :: a8_Xst)
                  (w3_s1LL [Occ=Once!] :: ()) ->
                  case w3_s1LL of _ [Occ=Dead] { () ->
                  case <= @ a8_Xst w_X1Me w1_X1Mg w2_X1Mi of _ [Occ=Dead] {
                    False -> (# (), () #);
                    True -> T11272a.$woverloaded @ a8_Xst w_X1Me w2_X1Mi
 w1_X1Mg ()
                  }
                  }}]
 T11272a.$woverloaded =
   \ (@ a8_Xst)
     (w_X1Me :: Ord a8_Xst)
     (w1_X1Mg :: a8_Xst)
     (w2_X1Mi :: a8_Xst)
     (w3_s1LL
        :: ()
        Unf=OtherCon []) ->
     case (a_r1OI @ a8_Xst w_X1Me w1_X1Mg w2_X1Mi w3_s1LL)
          `cast` (NTCo:Identity[0] <((), ())>_R
                  :: Identity ((), ()) ~R# ((), ()))
     of _ [Occ=Dead] { (ww1_s1LX, ww2_s1LY) ->
     (# ww1_s1LX, ww2_s1LY #)
     }

 -- RHS size: {terms: 26, types: 17, coercions: 10}
 a_r1OI
   :: forall a_a1zi.
      Ord a_a1zi =>
      a_a1zi -> a_a1zi -> () -> Identity ((), ())
 [GblId,
  Arity=4,
  Caf=NoCafRefs,
  Str=DmdType
 <S(LLLC(C(S))LLLL),U(A,A,A,C(C1(U)),A,A,A,A)><L,U><L,U><S,1*H>m]
 a_r1OI =
   \ (@ a8_a1zi)
     (w_s1LP :: Ord a8_a1zi)
     (w1_s1LQ :: a8_a1zi)
     (w2_s1LR :: a8_a1zi)
     (w3_s1LS :: ()) ->
     case w3_s1LS of _ [Occ=Dead] { () ->
     case <= @ a8_a1zi w_s1LP w1_s1LQ w2_s1LR of _ [Occ=Dead] {
       False ->
         lvl_r1OH
         `cast` (Sym (NTCo:Identity[0] <((), ())>_R)
                 :: ((), ()) ~R# Identity ((), ()));
       True ->
         case T11272a.$woverloaded @ a8_a1zi w_s1LP w2_s1LR w1_s1LQ ()
         of _ [Occ=Dead] { (# ww1_s1M1, ww2_s1M2 #) ->
         (ww1_s1M1, ww2_s1M2)
         `cast` (Sym (NTCo:Identity[0] <((), ())>_R)
                 :: ((), ()) ~R# Identity ((), ()))
         }
     }
     }
 end Rec }
 }}}
   That's bad; we'd prefer a tight self-recursive function.

 * Worse, it doesn't specialise, because the cast makes it look as if it
 doesn't have top-level lambdas.

 Need to think about this, but thought I'd jot down what I know so far.

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