#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 ,
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 ]
$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 ,
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 ,
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.
->
-> Sym <(GHC.ST.NTCo:ST[0]
)>
:: (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.
->
-> Sym <(GHC.ST.NTCo:ST[0] )>
:: (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
