Liberate case not happening
Simon M writes: Johan Tibell and I were looking at the code GHC produces for isPrefixOf
:
isPrefixOf :: (Eq a) => [a] -> [a] -> Bool
isPrefixOf [] _ = True
isPrefixOf _ [] = False
isPrefixOf (x:xs) (y:ys)= x == y && isPrefixOf xs ys
and noticed that it differs between 6.12 and 6.14 onwards incl 7.5, with the 6.12 code more heavily optimised. In particular, 6.12 applies liberate case so the unboxing of the Eq dictionary is pulled out of the loop, but 6.14 isn't doing this.
Here's the 6.12 core:
$ ghc -ddump-simpl -O2 isprefixof.hs -c -fliberate-case
==================== Tidy Core ====================
Test.isPrefixOf :: forall a_ade.
(GHC.Classes.Eq a_ade) =>
[a_ade] -> [a_ade] -> GHC.Bool.Bool
GblId
[Arity 3
NoCafRefs
Str: DmdType LSL]
Test.isPrefixOf =
\ (@ a_adE)
($dEq_adK :: GHC.Classes.Eq a_adE)
(eta_B2 :: [a_adE])
(eta1_B1 :: [a_adE]) ->
case eta_B2 of _ {
[] -> GHC.Bool.True;
: ipv_se3 ipv1_se4 ->
case eta1_B1 of _ {
[] -> GHC.Bool.False;
: ipv2_se7 ipv3_se8 ->
case $dEq_adK of _ { GHC.Classes.D:Eq tpl1_Xk _ ->
case tpl1_Xk ipv_se3 ipv2_se7 of _ {
GHC.Bool.False -> GHC.Bool.False;
GHC.Bool.True ->
letrec {
isPrefixOf1_seA :: [a_adE] -> [a_adE] -> GHC.Bool.Bool
LclId
[Arity 2
Str: DmdType SL]
isPrefixOf1_seA =
\ (ds_ddM :: [a_adE]) (ds1_ddN :: [a_adE]) ->
case ds_ddM of _ {
[] -> GHC.Bool.True;
: ipv4_Xes ipv5_Xeu ->
case ds1_ddN of _ {
[] -> GHC.Bool.False;
: ipv6_XeA ipv7_XeC ->
case tpl1_Xk ipv4_Xes ipv6_XeA of _ {
GHC.Bool.False -> GHC.Bool.False;
GHC.Bool.True -> isPrefixOf1_seA ipv5_Xeu ipv7_XeC
}
}
}; } in
isPrefixOf1_seA ipv1_se4 ipv3_se8
}
}
}
}
and the 6.14 code (also 7.5):
$ ghc-stage2 -ddump-simpl -O2 isprefixof.hs -c -fspec-constr
==================== Tidy Core ====================
Test.isPrefixOf
:: forall a_aav.
GHC.Classes.Eq a_aav =>
[a_aav] -> [a_aav] -> GHC.Bool.Bool
[GblId,
Arity=3,
Caf=NoCafRefs,
Str=DmdType LSL,
Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=3, Value=True,
ConLike=True, Cheap=True, Expandable=True,
Guidance=IF_ARGS [1 0 0] 19 0}]
Test.isPrefixOf =
\ (@ a_age)
($dEq_agk :: GHC.Classes.Eq a_age)
(eta_B2 :: [a_age])
(eta1_B1 :: [a_age]) ->
letrec {
isPrefixOf1_sha [Occ=LoopBreaker]
:: [a_age] -> [a_age] -> GHC.Bool.Bool
[LclId, Arity=2, Str=DmdType SL]
isPrefixOf1_sha =
\ (ds_dgm :: [a_age]) (ds1_dgn :: [a_age]) ->
case ds_dgm of _ {
[] -> GHC.Bool.True;
: ipv_sgD ipv1_sgE ->
case ds1_dgn of _ {
[] -> GHC.Bool.False;
: ipv2_sgH ipv3_sgI ->
case GHC.Classes.== @ a_age $dEq_agk ipv_sgD ipv2_sgH of _ {
GHC.Bool.False -> GHC.Bool.False;
GHC.Bool.True -> isPrefixOf1_sha ipv1_sgE ipv3_sgI
}
}
}; } in
isPrefixOf1_sha eta_B2 eta1_B1
Trac metadata
Trac field | Value |
---|---|
Version | 7.4.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |