Complain if we use a tuple tycon or data-con that is too big

Previously (Trac #6148) we were only complaining for the
distfix syntax (a,b,c).

2 files changed, 23 insertions, 12 deletions

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 798381b117..8b8beb9376 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 df3566d73c..e37860abb7 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)