[GHC] #13928: Providing a more specific argument prevents fusion caused by join point floating.

5 Jul 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

GHC

tags

participants (1)