diff options
| -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']) |