#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=, 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=, 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=, 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=, 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=] 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=, 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