#14079 closed bug (invalid)

Failure to do CPR in the presence of a local letrec

Reported by: nomeata Owned by:
Priority: normal Milestone:
Component: Compiler Version: 8.3
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

Consider this code:

{-# LANGUAGE BangPatterns #-}
module NoCPR (e) where
e :: (Int, Int) -> Int -> Int -> (Int, Int)
e x y n = je x y
 where je !x y | y > 0 = x
               | otherwise = je x (y + n)

(which is adapted from #5949).

We get this Core:

-- RHS size: {terms: 38, types: 27, coercions: 0, joins: 1/1}                
e :: (Int, Int) -> Int -> Int -> (Int, Int)                                  
[GblId,                                                                      
 Arity=3,                                                                    
 Caf=NoCafRefs,                                                              
 Str=<S,1*U(U,U)><S(S),1*U(U)><L,U(U)>m,                                     
 Unf=OtherCon []]                                                            
e = \ (x [Occ=Once!] :: (Int, Int))                                          
      (y [Occ=Once!] :: Int)                                                 
      (n [Occ=OnceL!] :: Int) ->                                             
      case x of { (ww1 [Occ=Once], ww2 [Occ=Once]) ->                        
      case y of { I# ww4 [Occ=Once] ->                                       
      joinrec {                                                              
        $wje [InlPrag=[0], Occ=LoopBreakerT[3]]                              
          :: Int -> Int -> Int# -> (Int, Int)                                
        [LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><S,U>m, Unf=OtherCon []]   
        $wje (ww5 [Occ=Once*] :: Int)                                        
             (ww6 [Occ=Once*] :: Int)                                        
             (ww7 :: Int#)                                                   
          = case ># ww7 0# of {                                              
              __DEFAULT ->                                                   
                case n of { I# y1 [Occ=Once] ->                              
                case +# ww7 y1 of sat { __DEFAULT -> jump $wje ww5 ww6 sat } 
                };                                                           
              1# -> (ww5, ww6)                                               
            }; } in                                                          
      jump $wje ww1 ww2 ww4                                                  
      }                                                                      
      }                                                                      

Why is there no CPR happening for e? In fact, why is there no unboxing happening – it was for the following similar code:

e :: (Int, Int) -> Int -> (Int, Int)
e x y = x `seq` if y > 10
        then x
        else e x (y + 1)

(This is a spin-off of the dicussion at https://phabricator.haskell.org/D3811#107708).

Change History (6)

comment:1 Changed 19 months ago by nomeata

Ah, in this case, this is because certainlyWillInline returns True for e, so tryWW will refrain from W/W’ing this function. If I mark it as NOINLINE then we get the desired code (note that the join-point has it’s return type changes as well:)

$we [InlPrag=NOINLINE] :: Int -> Int -> Int# -> Int -> (# Int, Int #)
[LclId, Arity=4, Str=<L,U><L,U><S,U><L,U(U)>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=4,unsat_ok=True,boring_ok=True)}]
$we
  = \ (ww :: Int)
      (ww :: Int)
      (ww [Dmd=<S,U>] :: Int#)
      (w [Dmd=<L,U(U)>] :: Int) ->
      joinrec {
        $wje [InlPrag=[0], Occ=LoopBreaker] :: Int -> Int -> Int# -> (# Int, Int #)
        [LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><S,U>,
         Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
                 WorkFree=True, Expandable=True,
                 Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=True)}]
        $wje (ww :: Int) (ww :: Int) (ww [Dmd=<S,U>] :: Int#)
          = case ># ww 0# of {
              __DEFAULT -> case w of { I# y [Dmd=<S,U>] -> jump $wje ww ww (+# ww y) };
              1# -> (# ww, ww #)
            }; } in
      jump $wje ww ww ww

comment:2 Changed 19 months ago by simonpj

When e is small we don't to w/w; insteead we inline the function bodily at all call sites.

If you make it bigger, thus

{-# NOINLINE dummy #-}
dummy x = x

e :: (Int, Int) -> Int -> Int -> (Int, Int)
e x y n = je x y
 where
   je !x y | y > 0 = x
           | otherwise = je x (dummy y + dummy n)

then e is big enough, and full w/w happens. Actually it looks fine to me. All the right things are happening. So is ther a bug here at all?

comment:3 Changed 19 months ago by nomeata

Not sure to what extend there is a bug, but I believe it explains the regressions when we introduce loopification.

Let’s start with this code.

je :: (Int, Int) -> Int -> (Int, Int)
je !x y | y > 0 = x
        | otherwise = je x (makeBig y + 1)

Without loopification, this stays a top-level recursive bindings. Even if it is small, it is never inlined, so w/w happens, and we get a nice worker, with both tuples unboxed:

$wje :: Int -> Int -> Int# -> (# Int, Int #)

This avoid allocation of tuples, which is great.

Now, let’s do loopification by hand (the extra n is just to avoid floating je to the top-level, because we do not support top-level join points:

e :: (Int, Int) -> Int -> Int -> (Int, Int)
e x y n = je x y
 where je !x y | y > 0 = x
               | otherwise = je x (y + n)

Now e is small and, by changing from recursive to non-recursive, now inlineable. Therefore w/w refuses to work on e and we get no worker for e. We do get a worker for the local join point je, but because it is a join-point, no CPR happens, and its type is

$wje :: Int -> Int -> Int# -> (Int, Int)

As you point out that other changes to e (such as making it look big, or marking it NOINLINE) avoid this and give it a nice wrapper. But that is a red herring: The code out there _is_ small and _isn’t_ marked NOINLINE.

Anyways, so we are stuck with an inlineable e without a worker. The next question is hence: What happens with it? If we indeed inline e, and inline it into a nice context (say, into case _ of (x,y) -> _, then case-of-case (and case-of-joinrec) will move this case deep into the letrec. But (and at this point I am running out of concrete examples. I guess I have to look closer at nofib), what if that does not happen?

comment:4 Changed 18 months ago by simonpj

I don't get this. I tried

{-# LANGUAGE BangPatterns #-}

module T14079 where

e1 :: (Int, Int) -> Int -> (Int, Int)
e1 !x y | y > 0 = x
        | otherwise = e1 x (y + 1)

e2 :: (Int, Int) -> Int -> Int -> (Int, Int)
e2 x y n = je x y
 where je !x y | y > 0 = x
               | otherwise = je x (y + n)

As you say I get a w/w split for e1. So if e1 is called applied to two arguments I'll inline the wrapper and good things will happen.

For for e1 I get something good too

e2 :: (Int, Int) -> Int -> Int -> (Int, Int)
[GblId,
 Arity=3,
 Caf=NoCafRefs,
 Str=<S,1*U(U,U)><S(S),1*U(U)><L,U(U)>m,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
         Tmpl= \ (x_a1VH [Occ=Once] :: (Int, Int))
                 (y_a1VI [Occ=Once] :: Int)
                 (n_a1VJ [Occ=OnceL!] :: Int) ->
                 joinrec {
                   je_s2nz [Occ=LoopBreakerT[2]] :: (Int, Int) -> Int -> (Int, Int)
                   [LclId[JoinId(2)], Arity=2, Unf=OtherCon []]
                   je_s2nz (x1_a1VL [Occ=Once!] :: (Int, Int))
                           (y1_a1VM [Occ=Once!] :: Int)
                     = case x1_a1VL of x2_X1VS { (_ [Occ=Dead], _ [Occ=Dead]) ->
                       case y1_a1VM of { GHC.Types.I# x3_a2mT ->
                       case GHC.Prim.># x3_a2mT 0# of {
                         __DEFAULT ->
                           jump je_s2nz
                             x2_X1VS
                             (case n_a1VJ of { GHC.Types.I# y2_a2nf [Occ=Once] ->
                              GHC.Types.I# (GHC.Prim.+# x3_a2mT y2_a2nf)
                              });
                         1# -> x2_X1VS
                       }
                       }
                       }; } in
                 jump je_s2nz x_a1VH y_a1VI}]
e2
  = \ (x_a1VH :: (Int, Int)) (y_a1VI :: Int) (n_a1VJ :: Int) ->
      case x_a1VH of { (ww1_s2ox, ww2_s2oy) ->
      case y_a1VI of { GHC.Types.I# ww4_s2oC ->
      joinrec {
        $wje_s2oE [InlPrag=[0], Occ=LoopBreaker]
          :: Int -> Int -> GHC.Prim.Int# -> (Int, Int)
        [LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><S,U>m, Unf=OtherCon []]
        $wje_s2oE (ww5_X2oV :: Int)
                  (ww6_X2oX :: Int)
                  (ww7_X2p2 :: GHC.Prim.Int#)
          = case GHC.Prim.># ww7_X2p2 0# of {
              __DEFAULT ->
                case n_a1VJ of { GHC.Types.I# y1_a2nf ->
                jump $wje_s2oE ww5_X2oV ww6_X2oX (GHC.Prim.+# ww7_X2p2 y1_a2nf)
                };
              1# -> (ww5_X2oV, ww6_X2oX)
            }; } in
      jump $wje_s2oE ww1_s2ox ww2_s2oy ww4_s2oC
      }
      }

e2's strictness signature says that it has the CPR property. It doesn't have a w/w split, but it'll be inlined wherever it is used.

Just to check, I tried this

f1 x y = e1 x (y+1)

f2 x y n = e2 x (y+t) n
  where
   t = length (reverse (reverse (reverse (reverse (reverse (reverse [1..n]))))))

The definition t is just make f2 big enough so that the strictness analyser will do a w/w split for it. Sure enough, good things happen

T14079.$wf2 [InlPrag=[0]]
  :: Int -> Int -> GHC.Prim.Int# -> GHC.Prim.Int# -> (# Int, Int #)
[GblId,
 Arity=4,
 Caf=NoCafRefs,
 Str=<L,U><L,U><S,U><S,U>,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0 0] 289 0}]
T14079.$wf2
  = \ (ww_s30e :: Int)
      (ww1_s30f :: Int)
      (ww2_s30j :: GHC.Prim.Int#)
      (ww3_s30n :: GHC.Prim.Int#) ->
      case GHC.List.$wlenAcc
             @ Int
             (GHC.List.reverse1
                @ Int
                (GHC.List.reverse1
                   @ Int
                   (GHC.List.reverse1
                      @ Int
                      (GHC.List.reverse1
                         @ Int
                         (GHC.List.reverse1
                            @ Int
                            (GHC.List.reverse1
                               @ Int (GHC.Enum.eftInt 1# ww3_s30n) (GHC.Types.[] @ Int))
                            (GHC.Types.[] @ Int))
                         (GHC.Types.[] @ Int))
                      (GHC.Types.[] @ Int))
                   (GHC.Types.[] @ Int))
                (GHC.Types.[] @ Int))
             0#
      of ww4_a2Yy
      { __DEFAULT ->
      joinrec {
        $wje_s308 [InlPrag=[0], Occ=LoopBreaker]
          :: Int -> Int -> GHC.Prim.Int# -> (# Int, Int #)
        [LclId[JoinId(3)], Arity=3, Str=<L,U><L,U><S,U>, Unf=OtherCon []]
        $wje_s308 (ww5_s301 :: Int)
                  (ww6_s302 :: Int)
                  (ww7_s306 :: GHC.Prim.Int#)
          = case GHC.Prim.># ww7_s306 0# of {
              __DEFAULT ->
                jump $wje_s308 ww5_s301 ww6_s302 (GHC.Prim.+# ww7_s306 ww3_s30n);
              1# -> (# ww5_s301, ww6_s302 #)
            }; } in
      jump $wje_s308 ww_s30e ww1_s30f (GHC.Prim.+# ww2_s30j ww4_a2Yy)
      }

-- RHS size: {terms: 22, types: 23, coercions: 0, joins: 0/0}
f2 [InlPrag=INLINE[0]] :: (Int, Int) -> Int -> Int -> (Int, Int)
[GblId,
 Arity=3,
 Caf=NoCafRefs,
 Str=<S,1*U(U,U)><S(S),1*U(U)><S(S),1*U(U)>m,
 Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
         WorkFree=True, Expandable=True,
         Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
         Tmpl= \ (w_s309 [Occ=Once!] :: (Int, Int))
                 (w1_s30a [Occ=Once!] :: Int)
                 (w2_s30b [Occ=Once!] :: Int) ->
                 case w_s309 of { (ww1_s30e [Occ=Once], ww2_s30f [Occ=Once]) ->
                 case w1_s30a of { GHC.Types.I# ww4_s30j [Occ=Once] ->
                 case w2_s30b of { GHC.Types.I# ww6_s30n [Occ=Once] ->
                 case T14079.$wf2 ww1_s30e ww2_s30f ww4_s30j ww6_s30n of
                 { (# ww8_s30I [Occ=Once], ww9_s30J [Occ=Once] #) ->
                 (ww8_s30I, ww9_s30J)
                 }
                 }
                 }
                 }}]
f2
  = \ (w_s309 :: (Int, Int)) (w1_s30a :: Int) (w2_s30b :: Int) ->
      case w_s309 of { (ww1_s30e, ww2_s30f) ->
      case w1_s30a of { GHC.Types.I# ww4_s30j ->
      case w2_s30b of { GHC.Types.I# ww6_s30n ->
      case T14079.$wf2 ww1_s30e ww2_s30f ww4_s30j ww6_s30n of
      { (# ww8_s30I, ww9_s30J #) ->
      (ww8_s30I, ww9_s30J)
      }
      }
      }
      }

This all looks fine to me. Are you sure there is a problem here?

comment:5 Changed 18 months ago by nomeata

Are you sure there is a problem here?

No, not very sure. I guess I was confused by trying to hunt down the regression. (I am still not convinced that there is no case where without loopification, CPR happens, but with loopification, CPR does not happen because the function can now be inlined, but after inlining CPR does still not happend, and thus we get more allocations. But I cannot easily reproduce such a case.)

comment:6 Changed 18 months ago by nomeata

Resolution: invalid
Status: newclosed
Note: See TracTickets for help on using tickets.