Providing a more specific argument prevents fusion caused by join point floating.
I don't know whether this is expected or not but I am writing it down here for the record.
Defining any
as in section 5 of the paper "compiling without continuations" produces nice fused code as promised. However, fixing the predicate in any
causes the fusion to stop happening producing potentially worse code.
module ListFusion where
find :: (a -> Bool) -> [a] -> Maybe a
find p xs = go xs
where
go [] = Nothing
go (x:xs) = if p x then Just x else go xs
fuses :: (Int -> Bool) -> [Int] -> Bool
fuses p xs = case find p xs of
Just x -> True
Nothing -> False
fuseNot :: (Int -> Bool) -> [Int] -> Bool
fuseNot _p xs = case find (> 4) xs of
Just x -> True
Nothing -> False
Core output
[1 of 1] Compiling ListFusion ( listfusion.hs, listfusion.o )
==================== Tidy Core ====================
Result size of Tidy Core
= {terms: 87, types: 82, coercions: 0, joins: 2/2}
-- RHS size: {terms: 21, types: 20, coercions: 0, joins: 1/1}
find :: forall a. (a -> Bool) -> [a] -> Maybe a
[GblId,
Arity=2,
Caf=NoCafRefs,
Str=<L,C(U)><S,1*U>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (@ a_a1UH)
(p_aSB [Occ=OnceL!] :: a_a1UH -> Bool)
(xs_aSC [Occ=Once] :: [a_a1UH]) ->
joinrec {
go_s28Z [Occ=LoopBreakerT[1]] :: [a_a1UH] -> Maybe a_a1UH
[LclId[JoinId(1)], Arity=1, Unf=OtherCon []]
go_s28Z (ds_d27L [Occ=Once!] :: [a_a1UH])
= case ds_d27L of {
[] -> GHC.Base.Nothing @ a_a1UH;
: x_aSE xs1_aSF [Occ=Once] ->
case p_aSB x_aSE of {
False -> jump go_s28Z xs1_aSF;
True -> GHC.Base.Just @ a_a1UH x_aSE
}
}; } in
jump go_s28Z xs_aSC}]
find
= \ (@ a_a1UH) (p_aSB :: a_a1UH -> Bool) (xs_aSC :: [a_a1UH]) ->
joinrec {
go_s28Z [Occ=LoopBreaker] :: [a_a1UH] -> Maybe a_a1UH
[LclId[JoinId(1)], Arity=1, Str=<S,1*U>, Unf=OtherCon []]
go_s28Z (ds_d27L :: [a_a1UH])
= case ds_d27L of {
[] -> GHC.Base.Nothing @ a_a1UH;
: x_aSE xs1_aSF ->
case p_aSB x_aSE of {
False -> jump go_s28Z xs1_aSF;
True -> GHC.Base.Just @ a_a1UH x_aSE
}
}; } in
jump go_s28Z xs_aSC
-- RHS size: {terms: 19, types: 15, coercions: 0, joins: 1/1}
fuses :: (Int -> Bool) -> [Int] -> Bool
[GblId,
Arity=2,
Caf=NoCafRefs,
Str=<L,C(U)><S,1*U>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ (p_aSG [Occ=OnceL!] :: Int -> Bool)
(xs_aSH [Occ=Once] :: [Int]) ->
joinrec {
go_s28X [Occ=LoopBreakerT[1]] :: [Int] -> Bool
[LclId[JoinId(1)], Arity=1, Unf=OtherCon []]
go_s28X (ds_d27L [Occ=Once!] :: [Int])
= case ds_d27L of {
[] -> GHC.Types.False;
: x_aSE [Occ=Once] xs1_aSF [Occ=Once] ->
case p_aSG x_aSE of {
False -> jump go_s28X xs1_aSF;
True -> GHC.Types.True
}
}; } in
jump go_s28X xs_aSH}]
fuses
= \ (p_aSG :: Int -> Bool) (xs_aSH :: [Int]) ->
joinrec {
go_s28X [Occ=LoopBreaker] :: [Int] -> Bool
[LclId[JoinId(1)], Arity=1, Str=<S,1*U>, Unf=OtherCon []]
go_s28X (ds_d27L :: [Int])
= case ds_d27L of {
[] -> GHC.Types.False;
: x_aSE xs1_aSF ->
case p_aSG x_aSE of {
False -> jump go_s28X xs1_aSF;
True -> GHC.Types.True
}
}; } in
jump go_s28X xs_aSH
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
ListFusion.$trModule4 :: GHC.Prim.Addr#
[GblId,
Caf=NoCafRefs,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
ListFusion.$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
ListFusion.$trModule3 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
ListFusion.$trModule3 = GHC.Types.TrNameS ListFusion.$trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
ListFusion.$trModule2 :: GHC.Prim.Addr#
[GblId,
Caf=NoCafRefs,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 0}]
ListFusion.$trModule2 = "ListFusion"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
ListFusion.$trModule1 :: GHC.Types.TrName
[GblId,
Caf=NoCafRefs,
Str=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
ListFusion.$trModule1 = GHC.Types.TrNameS ListFusion.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
ListFusion.$trModule :: GHC.Types.Module
[GblId,
Caf=NoCafRefs,
Str=m,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
ListFusion.$trModule
= GHC.Types.Module ListFusion.$trModule3 ListFusion.$trModule1
Rec {
-- RHS size: {terms: 20, types: 13, coercions: 0, joins: 0/0}
ListFusion.fuseNot_go [Occ=LoopBreaker] :: [Int] -> Maybe Int
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>]
ListFusion.fuseNot_go
= \ (ds_d27L :: [Int]) ->
case ds_d27L of {
[] -> GHC.Base.Nothing @ Int;
: x_aSE xs_aSF ->
case x_aSE of wild1_a28o { GHC.Types.I# x1_a28q ->
case GHC.Prim.tagToEnum# @ Bool (GHC.Prim.># x1_a28q 4#) of {
False -> ListFusion.fuseNot_go xs_aSF;
True -> GHC.Base.Just @ Int wild1_a28o
}
}
}
end Rec }
-- RHS size: {terms: 9, types: 7, coercions: 0, joins: 0/0}
fuseNot :: (Int -> Bool) -> [Int] -> Bool
[GblId,
Arity=2,
Caf=NoCafRefs,
Str=<L,A><S,1*U>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
Tmpl= \ _ [Occ=Dead] (xs_aSK [Occ=Once] :: [Int]) ->
case ListFusion.fuseNot_go xs_aSK of {
Nothing -> GHC.Types.False;
Just _ [Occ=Dead] -> GHC.Types.True
}}]
fuseNot
= \ _ [Occ=Dead] (xs_aSK :: [Int]) ->
case ListFusion.fuseNot_go xs_aSK of {
Nothing -> GHC.Types.False;
Just x_a1U5 -> GHC.Types.True
}
Trac metadata
Trac field | Value |
---|---|
Version | 8.0.1 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |