Opened 2 years ago

#13928 new bug

Providing a more specific argument prevents fusion caused by join point floating.

Reported by: mpickering Owned by:
Priority: normal Milestone:
Component: Compiler Version: 8.0.1
Keywords: JoinPoints Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case:
Blocked By: Blocking:
Related Tickets: Differential Rev(s):
Wiki Page:

Description

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
      }

Change History (0)

Note: See TracTickets for help on using tickets.