Commit fe0ae8d5 authored by Simon Peyton Jones's avatar Simon Peyton Jones

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).
parent 177134e9
...@@ -37,7 +37,7 @@ module RnEnv ( ...@@ -37,7 +37,7 @@ module RnEnv (
extendTyVarEnvFVRn, extendTyVarEnvFVRn,
checkDupRdrNames, checkShadowedRdrNames, checkDupRdrNames, checkShadowedRdrNames,
checkDupNames, checkDupAndShadowedNames, checkDupNames, checkDupAndShadowedNames, checkTupSize,
addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS, addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
warnUnusedMatches, warnUnusedMatches,
warnUnusedTopBinds, warnUnusedLocalBinds, warnUnusedTopBinds, warnUnusedLocalBinds,
...@@ -61,7 +61,8 @@ import NameEnv ...@@ -61,7 +61,8 @@ import NameEnv
import Avail import Avail
import Module ( ModuleName, moduleName ) import Module ( ModuleName, moduleName )
import UniqFM import UniqFM
import DataCon ( dataConFieldLabels ) import DataCon ( dataConFieldLabels, dataConTyCon )
import TyCon ( isTupleTyCon, tyConArity )
import PrelNames ( mkUnboundName, rOOT_MAIN, forall_tv_RDR ) import PrelNames ( mkUnboundName, rOOT_MAIN, forall_tv_RDR )
import ErrUtils ( MsgDoc ) import ErrUtils ( MsgDoc )
import SrcLoc import SrcLoc
...@@ -73,6 +74,7 @@ import DynFlags ...@@ -73,6 +74,7 @@ import DynFlags
import FastString import FastString
import Control.Monad import Control.Monad
import qualified Data.Set as Set import qualified Data.Set as Set
import Constants ( mAX_TUPLE_SIZE )
\end{code} \end{code}
\begin{code} \begin{code}
...@@ -234,8 +236,18 @@ lookupTopBndrRn_maybe rdr_name ...@@ -234,8 +236,18 @@ lookupTopBndrRn_maybe rdr_name
lookupExactOcc :: Name -> RnM Name lookupExactOcc :: Name -> RnM Name
-- See Note [Looking up Exact RdrNames] -- See Note [Looking up Exact RdrNames]
lookupExactOcc name 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 | isExternalName name
= return name = return name
| otherwise | otherwise
= do { env <- getGlobalRdrEnv = do { env <- getGlobalRdrEnv
; let -- See Note [Splicing Exact names] ; let -- See Note [Splicing Exact names]
...@@ -1649,6 +1661,15 @@ opDeclErr :: RdrName -> SDoc ...@@ -1649,6 +1661,15 @@ opDeclErr :: RdrName -> SDoc
opDeclErr n opDeclErr n
= hang (ptext (sLit "Illegal declaration of a type or class operator") <+> quotes (ppr 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")) 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} \end{code}
......
...@@ -50,7 +50,6 @@ import RnEnv ...@@ -50,7 +50,6 @@ import RnEnv
import RnTypes import RnTypes
import DynFlags import DynFlags
import PrelNames import PrelNames
import Constants ( mAX_TUPLE_SIZE )
import Name import Name
import NameSet import NameSet
import RdrName import RdrName
...@@ -626,15 +625,6 @@ rnOverLit lit@(OverLit {ol_val=val}) ...@@ -626,15 +625,6 @@ rnOverLit lit@(OverLit {ol_val=val})
%************************************************************************ %************************************************************************
\begin{code} \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 :: Outputable a => a -> SDoc
patSigErr ty patSigErr ty
= (ptext (sLit "Illegal signature in pattern:") <+> ppr ty) = (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment