Complain if we use a tuple tycon or data-con that is too big
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 7 Jun 2012 13:04:20 +0000 (14:04 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 7 Jun 2012 13:04:20 +0000 (14:04 +0100)
Previously (Trac #6148) we were only complaining for the
distfix syntax (a,b,c).

compiler/rename/RnEnv.lhs
compiler/rename/RnPat.lhs

index 798381b..8b8beb9 100644 (file)
@@ -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}
 
 
index df3566d..e37860a 100644 (file)
@@ -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)