[commit: ghc] master: New lint check: Check idArity invariants (#10181) (567db32)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/567db32b074860723e2b7c38f119b1880a803775/ghc

>---------------------------------------------------------------

commit 567db32b074860723e2b7c38f119b1880a803775
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sun Mar 22 17:51:51 2015 +0100

    New lint check: Check idArity invariants (#10181)
    
    The arity of an id should not be larger than what the type allows, and
    it should also not contradict the strictness signature. This adds a lint
    check for that.
    
    This broke test T8743, uncovering a bug in the SOURCE import machinery,
    which is now filed as #10182.


>---------------------------------------------------------------

567db32b074860723e2b7c38f119b1880a803775
 compiler/coreSyn/CoreLint.hs                 | 20 ++++++++++++++++++++
 testsuite/tests/stranal/should_compile/all.T |  2 +-
 2 files changed, 21 insertions(+), 1 deletion(-)

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index c615ea6..c454334 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 184ff1e..eae3ba0 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -18,7 +18,7 @@ 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