diff options
| -rw-r--r-- | compiler/coreSyn/CoreLint.hs | 20 | ||||
| -rw-r--r-- | testsuite/tests/stranal/should_compile/all.T | 4 |
2 files changed, 22 insertions, 2 deletions
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index 690836a1aa..a81c9c39ed 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -56,6 +56,8 @@ import Util import InstEnv ( instanceDFunId ) import OptCoercion ( checkAxInstCo ) import UniqSupply +import CoreArity ( typeArity ) +import Demand ( splitStrictSig, isBotRes ) import HscTypes import DynFlags @@ -487,6 +489,24 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) -- StrictSig dmd_ty -> idArity binder >= dmdTypeDepth dmd_ty || exprIsTrivial rhs) -- (mkArityMsg binder) + -- Check that the binder's arity is within the bounds imposed by + -- the type and the strictness signature. See Note [exprArity invariant] + -- and Note [Trimming arity] + ; checkL (idArity binder <= length (typeArity (idType binder))) + (ptext (sLit "idArity") <+> ppr (idArity binder) <+> + ptext (sLit "exceeds typeArity") <+> + ppr (length (typeArity (idType binder))) <> colon <+> + ppr binder) + + ; case splitStrictSig (idStrictness binder) of + (demands, result_info) | isBotRes result_info -> + checkL (idArity binder <= length demands) + (ptext (sLit "idArity") <+> ppr (idArity binder) <+> + ptext (sLit "exceeds arity imposed by the strictness signature") <+> + ppr (idStrictness binder) <> colon <+> + ppr binder) + _ -> return () + ; lintIdUnfolding binder binder_ty (idUnfolding binder) } -- We should check the unfolding, if any, but this is tricky because diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index 184ff1ec88..eae3ba01b3 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -18,8 +18,8 @@ test('newtype', req_profiling, compile, ['-prof -auto-all']) test('T1988', normal, compile, ['']) test('T8467', normal, compile, ['']) test('T8037', normal, compile, ['']) -test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0']) +test('T8743', [ extra_clean(['T8743.o-boot', 'T8743.hi-boot']), expect_broken(10182) ], multimod_compile, ['T8743', '-v0']) test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) # T9208 fails (and should do so) if you have assertion checking on in the compiler -# Hence the above expect_broken. See comments in the Trac ticket
\ No newline at end of file +# Hence the above expect_broken. See comments in the Trac ticket |