[GHC] #2440: Bad code with type families

[GHC]

#2440: Bad code with type families
--------------------------------------+-------------------------------------
  Reporter:  rl                       |          Owner:                  
      Type:  bug                      |         Status:  closed          
  Priority:  lowest                   |      Milestone:  7.6.2           
 Component:  Compiler                 |        Version:  6.9             
Resolution:  fixed                    |       Keywords:                  
        Os:  Unknown/Multiple         |   Architecture:  Unknown/Multiple
   Failure:  Runtime performance bug  |     Difficulty:  Unknown         
  Testcase:                           |      Blockedby:                  
  Blocking:                           |        Related:                  
--------------------------------------+-------------------------------------
Changes (by simonpj):

  * status:  new => closed
  * resolution:  => fixed


Comment:

 Well #2859 concerns optimising coercions, which was a sideline on this
 ticket, and is indeed fixed.

 However, I tried compiling `T2440` with `-O` and got this resonably good
 code.  In particular, the worker for `foo` has arity 3 as desired. So I'll
 close.

 {{{
 Foo.$wa
   :: forall s_agY.
      Foo.Vec s_agY
      -> GHC.Prim.Int#
      -> GHC.Prim.State# s_agY
      -> (# GHC.Prim.State# s_agY, GHC.Types.Int #)
 [GblId,
  Arity=3,
  Caf=NoCafRefs,
  Str=DmdType <L,U(U(U))><S,U><L,U>,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=3, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=IF_ARGS [20 0 0] 142 0}]
 Foo.$wa =
   \ (@ s_agY)
     (w_sr0 :: Foo.Vec s_agY)
     (ww_sr3 :: GHC.Prim.Int#)
     (w1_sr5 :: GHC.Prim.State# s_agY) ->
     letrec {
       $wa1_sr8 [Occ=LoopBreaker]
         :: GHC.Prim.Int#
            -> GHC.Prim.State# s_agY
            -> (# GHC.Prim.State# s_agY, GHC.Types.Int #)
       [LclId, Arity=2, Str=DmdType <S,U><L,U>]
       $wa1_sr8 =
         \ (ww1_sqT :: GHC.Prim.Int#) (w2_sqV :: GHC.Prim.State# s_agY) ->
           case ww1_sqT of ds_Xok {
             __DEFAULT ->
               case w_sr0 of _ { Foo.Vec r_afI ->
               case r_afI of _ { GHC.STRef.STRef var#_apW ->
               case GHC.Prim.readMutVar# @ s_agY @ GHC.Types.Int var#_apW
 w2_sqV
               of _ { (# ipv_aph, ipv1_api #) ->
               case ipv1_api of _ { GHC.Types.I# x_aoV ->
               $wa1_sr8 (GHC.Prim.+# x_aoV ds_Xok) ipv_aph
               }
               }
               }
               };
             0 -> (# w2_sqV, Foo.foo2 #)
           }; } in
     $wa1_sr8 ww_sr3 w1_sr5

 Foo.foo1 [InlPrag=INLINE[0]]
   :: forall s_agY.
      Foo.Vec s_agY
      -> GHC.Types.Int
      -> GHC.Prim.State# s_agY
      -> (# GHC.Prim.State# s_agY, GHC.Types.Int #)
 [GblId,
  Arity=3,
  Caf=NoCafRefs,
  Str=DmdType <L,U(U(U))><S(S),U(U)><L,U>,
  Unf=Unf{Src=Worker=Foo.$wa, TopLvl=True, Arity=3, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False)
          Tmpl= \ (@ s_agY)
                  (w_sr0 [Occ=Once] :: Foo.Vec s_agY)
                  (w1_sr1 [Occ=Once!] :: GHC.Types.Int)
                  (w2_sr5 [Occ=Once] :: GHC.Prim.State# s_agY) ->
                  case w1_sr1 of _ { GHC.Types.I# ww_sr3 [Occ=Once] ->
                  Foo.$wa @ s_agY w_sr0 ww_sr3 w2_sr5
                  }}]
 Foo.foo1 =
   \ (@ s_agY)
     (w_sr0 :: Foo.Vec s_agY)
     (w1_sr1 :: GHC.Types.Int)
     (w2_sr5 :: GHC.Prim.State# s_agY) ->
     case w1_sr1 of _ { GHC.Types.I# ww_sr3 ->
     Foo.$wa @ s_agY w_sr0 ww_sr3 w2_sr5
     }

 Foo.foo
   :: forall s_afc.
      Foo.Vec s_afc -> GHC.Types.Int -> GHC.ST.ST s_afc GHC.Types.Int
 [GblId,
  Arity=3,
  Caf=NoCafRefs,
  Str=DmdType <L,U(U(U))><S(S),U(U)><L,U>,
  Unf=Unf{Src=InlineStable, TopLvl=True, Arity=0, Value=True,
          ConLike=True, WorkFree=True, Expandable=True,
          Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=True)
          Tmpl= Foo.foo1
                `cast` (forall s_agY.
                        <Foo.Vec s_agY>
                        -> <GHC.Types.Int>
                        -> Sym <(GHC.ST.NTCo:ST[0] <s_agY>
 <GHC.Types.Int>)>
                        :: (forall s_agY.
                            Foo.Vec s_agY -> GHC.Types.Int -> GHC.ST.STRep
 s_agY GHC.Types.Int)
                             ~#
                           (forall s_agY.
                            Foo.Vec s_agY -> GHC.Types.Int -> GHC.ST.ST
 s_agY GHC.Types.Int))}]
 Foo.foo =
   Foo.foo1
   `cast` (forall s_agY.
           <Foo.Vec s_agY>
           -> <GHC.Types.Int>
           -> Sym <(GHC.ST.NTCo:ST[0] <s_agY> <GHC.Types.Int>)>
           :: (forall s_agY.
               Foo.Vec s_agY -> GHC.Types.Int -> GHC.ST.STRep s_agY
 GHC.Types.Int)
                ~#
              (forall s_agY.
               Foo.Vec s_agY -> GHC.Types.Int -> GHC.ST.ST s_agY
 GHC.Types.Int))
 }}}

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