From ee5881e5ce7cddd0bf5dd0b3dc1eef739903e57b Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 3 Dec 2004 16:59:43 +0000 Subject: [PATCH] [project @ 2004-12-03 16:59:43 by simonpj] Make Core Lint check for 1-tuples --- ghc/compiler/coreSyn/CoreLint.lhs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs index 2f36d53..dfc6fe8 100644 --- a/ghc/compiler/coreSyn/CoreLint.lhs +++ b/ghc/compiler/coreSyn/CoreLint.lhs @@ -18,7 +18,8 @@ import CoreUtils ( findDefault, exprOkForSpeculation, coreBindsSize, mkPiType ) import Unify ( coreRefineTys ) import Bag import Literal ( literalType ) -import DataCon ( dataConRepType, isVanillaDataCon, dataConTyCon, dataConResTy ) +import DataCon ( dataConRepType, isVanillaDataCon, dataConTyCon, dataConResTy, dataConWorkId ) +import TysWiredIn ( tupleCon ) import Var ( Var, Id, TyVar, idType, tyVarKind, mustHaveLocalBinding ) import VarSet import Name ( getSrcLoc ) @@ -35,7 +36,7 @@ import Type ( Type, tyVarsOfType, eqType, TvSubst, TvSubstEnv, setTvSubstEnv, substTy, extendTvSubst, isInScope ) import TyCon ( isPrimTyCon ) -import BasicTypes ( RecFlag(..), isNonRec ) +import BasicTypes ( RecFlag(..), Boxity(..), isNonRec ) import CmdLineOpts import Outputable @@ -590,7 +591,12 @@ extendSubstL tv ty m \begin{code} checkIdInScope :: Var -> LintM () checkIdInScope id - = checkInScope (ptext SLIT("is out of scope")) id + = do { checkL (not (id == oneTupleDataConId)) + (ptext SLIT("Illegal one-tuple")) + ; checkInScope (ptext SLIT("is out of scope")) id } + +oneTupleDataConId :: Id -- Should not happen +oneTupleDataConId = dataConWorkId (tupleCon Boxed 1) checkBndrIdInScope :: Var -> Var -> LintM () checkBndrIdInScope binder id -- 1.7.10.4