[GHC] #13928: Providing a more specific argument prevents fusion caused by join point floating.
GHC
ghc-devs at haskell.org
Wed Jul 5 13:44:48 UTC 2017
#13928: Providing a more specific argument prevents fusion caused by join point
floating.
-------------------------------------+-------------------------------------
Reporter: mpickering | Owner: (none)
Type: bug | Status: new
Priority: normal | Milestone:
Component: Compiler | Version: 8.0.1
Keywords: JoinPoints | Operating System: Unknown/Multiple
Architecture: | Type of failure: None/Unknown
Unknown/Multiple |
Test Case: | Blocked By:
Blocking: | Related Tickets:
Differential Rev(s): | Wiki Page:
-------------------------------------+-------------------------------------
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
}
}}}
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13928>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list