Opened 2 years ago

Closed 2 years ago

## #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 2 years ago by

### comment:2 Changed 2 years ago by

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 2 years ago by

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 2 years ago by

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 2 years ago by

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 2 years ago by

Resolution: | → invalid |
---|---|

Status: | new → closed |

**Note:**See TracTickets for help on using tickets.

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:)