diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-08-25 16:21:27 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-26 13:39:34 -0400 |
commit | b365335180e82088d5a94b262c79c25b33ef0dc3 (patch) | |
tree | 66416baad51e88ad62e047bd022f5cbd3f8b4b17 | |
parent | 0759c069e7cf328c8e397623bb2e5403de52e869 (diff) | |
download | haskell-b365335180e82088d5a94b262c79c25b33ef0dc3.tar.gz |
CallArity: Consider shadowing introduced by case and field binders
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.
-rw-r--r-- | compiler/GHC/Core/Opt/CallArity.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/callarity/should_compile/Makefile | 3 | ||||
-rw-r--r-- | testsuite/tests/callarity/should_compile/T20283.hs | 23 | ||||
-rw-r--r-- | testsuite/tests/callarity/should_compile/all.T | 8 |
4 files changed, 35 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 diff --git a/testsuite/tests/callarity/should_compile/Makefile b/testsuite/tests/callarity/should_compile/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/callarity/should_compile/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/callarity/should_compile/T20283.hs b/testsuite/tests/callarity/should_compile/T20283.hs new file mode 100644 index 0000000000..658bbf3c50 --- /dev/null +++ b/testsuite/tests/callarity/should_compile/T20283.hs @@ -0,0 +1,23 @@ +module T20283 where + +import Data.Array + +polynomial :: (Array (Int, Int) (Array (Int, Int) Double)) -> Int -> (Array Int Double) -> (Array Int Double) -> Double -> Double -> Double +polynomial g degree rho_table theta_table rho_value theta_value = + + let { + table_search table value = + let { + (low, high) = bounds table ; + search_down i = if value > (table!(i - 1)) then + i else search_down (i - 1) + } in if value > (table!high) then + high + 1 else if value <= (table!low) then + low else search_down high ; + rho_index = table_search rho_table rho_value ; + theta_index = table_search theta_table theta_value ; + a = g!(rho_index, theta_index) + } in foldl (+) 0 [ ((a!(i, j)) * rho_value ^ (i::Int)) + * theta_value ^ j | i <- [0..degree], + j <- [0..degree] ] + diff --git a/testsuite/tests/callarity/should_compile/all.T b/testsuite/tests/callarity/should_compile/all.T new file mode 100644 index 0000000000..88f16ec629 --- /dev/null +++ b/testsuite/tests/callarity/should_compile/all.T @@ -0,0 +1,8 @@ +# Only compile with optimisation +setTestOpts( only_ways(['optasm']) ) + +# The gist here is that the n_X1 :: Double -> Double binding we see in +# CallArity will be eta-expanded, inlined and thus not be seen in simplified +# output. There should be no other Double -> Double bindings, so testing for +# the absence of the sig should be reasonably precise. +test('T20283', [ grep_errmsg(r':: Double -> Double') ], compile, ['-dppr-cols=1000 -ddump-simpl']) |