CallArity: Consider shadowing introduced by case and field binderswip/T20283

In #20283, we saw a regression in `simple` due to CallArity for a very subtle
reason: It simply didn't handle shadowing of case binders and constructor field
binders!

The test case T20283 has a very interesting binding `n_X1` that we want to
eta-expand and that has a Unique (on GHC HEAD) that is reused by the Simplifier
for a case binder:
```
  let { n_X1 = ... } in
    ...
      let {
        lvl_s1Ul
          = ... case x_a1Rg of wild_X1 {
                  __DEFAULT -> f_s1Tx rho_value_awA (GHC.Types.I# wild_X1);
                  0# -> lvl_s1TN
                } ...
          } in
      letrec {
        go3_X3
          = \ (x_X4 :: GHC.Prim.Int#) (v_a1P9 [OS=OneShot] :: Double) ->
              let {
                karg_s1Wu = ...
                                    case lvl_s1Ul of { GHC.Types.D# y_a1Qf ->
                            ...
                    } } in
              case GHC.Prim.==# x_X4 y_a1R7 of {
                __DEFAULT -> go3_X3 (GHC.Prim.+# x_X4 1#) karg_s1Wu;
                1# -> n_X1 karg_s1Wu -- Here we will assume that karg calls n_X1!
              }; } in
      go3_X3 0#;
```

Since the Case case of CallArity doesn't delete `X1` from the set of variables
it is interested in knowing the usages of, we leak a very boring usage (of the
case binder!) into the co-call graph that we mistakenly take for a usage of
`n_X1`. We conclude that `lvl_s1Ul` and transitively `karg_s1Wu` call `n_X1`
when really they don't. That culminates in the conclusion that `n_X1 karg_s1Wu`
calls `n_X1` more than once. Wrong!

Fortunately, this bug (which has been there right from CallArity's inception,
I suppose) will never lead to a CallArity that is too optimistic. So by fixing
this bug, we get strictly more opportunities for CallArity and all of them
should be sound to exploit.

Fixes #20283.

1 files changed, 1 insertions, 1 deletions

diff --git a/compiler/GHC/Core/Opt/CallArity.hs b/compiler/GHC/Core/Opt/CallArity.hs
index 254b215537..d8d9749941 100644
--- a/compiler/GHC/Core/Opt/CallArity.hs
+++ b/compiler/GHC/Core/Opt/CallArity.hs
@@ -525,7 +525,7 @@ callArityAnal arity int (Case scrut bndr ty alts)
       (final_ae, Case scrut' bndr ty alts')
   where
     (alt_aes, alts') = unzip $ map go alts
-    go (Alt dc bndrs e) = let (ae, e') = callArityAnal arity int e
+    go (Alt dc bndrs e) = let (ae, e') = callArityAnal arity (int `delVarSetList` (bndr:bndrs)) e
                           in  (ae, Alt dc bndrs e')
     alt_ae = lubRess alt_aes
     (scrut_ae, scrut') = callArityAnal 0 int scrut