CPR analysis too optimistic when returning a component of a product

Sorry the ticket summary is not great, but here is an example.

module PM where

-- Some nonsense so that the simplifier can't see through
-- to the I# constructor
pm :: Int -> Int -> (Int, Int)
pm x y = (l !! 0, l !! 1)
  where l = [x+y, x-y]
{-# NOINLINE pm #-}

m :: Int -> Int -> Int
m x y = case pm x y of
  (pr, mr) -> mr

The generated Core is

pm [InlPrag=NOINLINE] :: Int -> Int -> (Int, Int)
[GblId, Arity=2, Str=DmdType <L,U(U)><L,U(U)>m]   -- ok, pm does construct a pair
pm = [...]

m :: Int -> Int -> Int
[GblId,
 Arity=2,
 Str=DmdType <L,U(U)><L,U(U)>m,                   -- but where did this come from?
 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= \ (x_as5 [Occ=Once] :: Int) (y_as6 [Occ=Once] :: Int) ->
                 case pm x_as5 y_as6
                 of _ [Occ=Dead] { (_ [Occ=Dead], mr_as8 [Occ=Once]) ->
                 mr_as8
                 }}]
m =
  \ (x_as5 :: Int) (y_as6 :: Int) ->
    case pm x_as5 y_as6 of _ [Occ=Dead] { (pr_as7, mr_as8) -> mr_as8 }

I think what's happening is that the body of the function is strict in mr_as8 (it's the entire body) and so mr_as8 is given the CPR property as described in Notes [CPR in a product case alternative] and [Initial CPR for strict binders]. But the reason it is strict is that we are going to need to evaluate it later, not that we have evaluated it already, so the logic in those notes does not apply here.

Reverting 0696fc6d makes m's CPR property go away.

This arises in #10678 (closed) since a function which is an application of, say, runST now has this form (runST (ST st_rep) = case runRW# st_rep of (# _, a #) -> a). It causes wasted unboxing and reboxing of the value returned from runST.

Trac metadata

Trac field	Value
Version	7.11
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking	#10678 (closed)
CC
Operating system
Architecture

mentioned in issue #10678 (closed)

changed weight to 5

added Tbug Trac import labels

mentioned in issue #10695 (closed)

Something funny happened while filing this ticket (see #10695 (closed)) and I did not receive an email about it, so here is a content-free comment to make sure the ticket gets seen.

Trac metadata

Trac field	Value
Blocking	#10678 (closed) →

Trac metadata

Trac field	Value
Blocking	- → #10678 (closed)

To demonstrate the problem, if I build with -funfolding-use-threshold=1 to induce w/w to run, I get this core (with -dsuppress-all):

-- RHS size: {terms: 11, types: 9, coercions: 0}
$wm
$wm =
  \ w_sDP w1_sDQ ->
    case pm w_sDP w1_sDQ of _ { (pr_as8, mr_as9) ->
    case mr_as9 of _ { I# ww1_sDT -> ww1_sDT }
    }

-- RHS size: {terms: 9, types: 3, coercions: 0}
m
m =
  \ w_sDP w1_sDQ ->
    case $wm w_sDP w1_sDQ of ww_sDT { __DEFAULT -> I# ww_sDT }

This can only lose, never gain, compared to not generating a worker/wrapper pair.

mentioned in commit 499b926b

closed

I think I've fixed this. Thanks for identifying it so clearly.

I hope this unblocks your runST work.

Simon

Trac metadata

Trac field	Value
Resolution	Unresolved → ResolvedFixed
Test case	- → stranal/should_compile/T10694

Trac metadata

Trac field	Value
Blocking	#10678 (closed) →

changed milestone to %8.0.1

added Pnormal label

marked this issue as related to #18174 (closed)