[commit: ghc] wip/T10181: New lint check: Check idArity invariants (#10181) (fe42a82)

[git at git.haskell.org]

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

On branch  : wip/T10181
Link       : http://ghc.haskell.org/trac/ghc/changeset/fe42a82e46a8f28ece1ac6d541232f58cb45dec1/ghc

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

commit fe42a82e46a8f28ece1ac6d541232f58cb45dec1
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.


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

fe42a82e46a8f28ece1ac6d541232f58cb45dec1
 compiler/coreSyn/CoreLint.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 690836a..a81c9c3 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