#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