diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 798381b117bcd8d803a1be6f25123c7a0a00d05f..8b8beb937642613813ad1c1e2a5ef1c84aa092af 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -37,7 +37,7 @@ module RnEnv ( extendTyVarEnvFVRn, checkDupRdrNames, checkShadowedRdrNames, - checkDupNames, checkDupAndShadowedNames, + checkDupNames, checkDupAndShadowedNames, checkTupSize, addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS, warnUnusedMatches, warnUnusedTopBinds, warnUnusedLocalBinds, @@ -61,7 +61,8 @@ import NameEnv import Avail import Module ( ModuleName, moduleName ) import UniqFM -import DataCon ( dataConFieldLabels ) +import DataCon ( dataConFieldLabels, dataConTyCon ) +import TyCon ( isTupleTyCon, tyConArity ) import PrelNames ( mkUnboundName, rOOT_MAIN, forall_tv_RDR ) import ErrUtils ( MsgDoc ) import SrcLoc @@ -73,6 +74,7 @@ import DynFlags import FastString import Control.Monad import qualified Data.Set as Set +import Constants ( mAX_TUPLE_SIZE ) \end{code} \begin{code} @@ -234,8 +236,18 @@ lookupTopBndrRn_maybe rdr_name lookupExactOcc :: Name -> RnM Name -- See Note [Looking up Exact RdrNames] lookupExactOcc name + | Just thing <- wiredInNameTyThing_maybe name + , Just tycon <- case thing of + ATyCon tc -> Just tc + ADataCon dc -> Just (dataConTyCon dc) + _ -> Nothing + , isTupleTyCon tycon + = do { checkTupSize (tyConArity tycon) + ; return name } + | isExternalName name = return name + | otherwise = do { env <- getGlobalRdrEnv ; let -- See Note [Splicing Exact names] @@ -1649,6 +1661,15 @@ opDeclErr :: RdrName -> SDoc opDeclErr n = hang (ptext (sLit "Illegal declaration of a type or class operator") <+> quotes (ppr n)) 2 (ptext (sLit "Use -XTypeOperators to declare operators in type and declarations")) + +checkTupSize :: Int -> RnM () +checkTupSize tup_size + | tup_size <= mAX_TUPLE_SIZE + = return () + | otherwise + = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"), + nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)), + nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))]) \end{code} diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index df3566d73c2d5bc271023c99d242ace62050e047..e37860abb7bfa2ca67ea162f352602518e53a7c0 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -50,7 +50,6 @@ import RnEnv import RnTypes import DynFlags import PrelNames -import Constants ( mAX_TUPLE_SIZE ) import Name import NameSet import RdrName @@ -626,15 +625,6 @@ rnOverLit lit@(OverLit {ol_val=val}) %************************************************************************ \begin{code} -checkTupSize :: Int -> RnM () -checkTupSize tup_size - | tup_size <= mAX_TUPLE_SIZE - = return () - | otherwise - = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"), - nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)), - nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))]) - patSigErr :: Outputable a => a -> SDoc patSigErr ty = (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)