Commit 4dd415e9 authored by simonpj's avatar simonpj
Browse files

[project @ 2005-12-16 15:15:08 by simonpj]

-----------------------------------------
	Test for repated type variables in an instance decl context;
	this should require -fallow-undecidable-instances'
	-----------------------------------------

	Merge to stable branch
parent 6cfd14d1
...@@ -53,7 +53,7 @@ import TypeRep ( Type(..), PredType(..), -- Friend; can see representation ...@@ -53,7 +53,7 @@ import TypeRep ( Type(..), PredType(..), -- Friend; can see representation
import TcType ( TcType, TcThetaType, TcTauType, TcPredType, import TcType ( TcType, TcThetaType, TcTauType, TcPredType,
TcTyVarSet, TcKind, TcTyVar, TcTyVarDetails(..), TcTyVarSet, TcKind, TcTyVar, TcTyVarDetails(..),
MetaDetails(..), SkolemInfo(..), isMetaTyVar, metaTvRef, MetaDetails(..), SkolemInfo(..), isMetaTyVar, metaTvRef,
tcCmpPred, isClassPred, tcCmpPred, tcEqType, isClassPred,
tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe, tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
tcValidInstHeadTy, tcSplitForAllTys, tcValidInstHeadTy, tcSplitForAllTys,
tcIsTyVarTy, tcSplitSigmaTy, tcIsTyVarTy, tcSplitSigmaTy,
...@@ -83,7 +83,7 @@ import VarEnv ...@@ -83,7 +83,7 @@ import VarEnv
import DynFlags ( dopt, DynFlag(..) ) import DynFlags ( dopt, DynFlag(..) )
import UniqSupply ( uniqsFromSupply ) import UniqSupply ( uniqsFromSupply )
import Util ( nOfThem, isSingleton, notNull ) import Util ( nOfThem, isSingleton, notNull )
import ListSetOps ( removeDups ) import ListSetOps ( removeDups, findDupsEq )
import SrcLoc ( unLoc ) import SrcLoc ( unLoc )
import Outputable import Outputable
\end{code} \end{code}
...@@ -977,12 +977,16 @@ check_class_pred_tys dflags ctxt tys ...@@ -977,12 +977,16 @@ check_class_pred_tys dflags ctxt tys
TypeCtxt -> True -- {-# SPECIALISE instance Eq (T Int) #-} is fine TypeCtxt -> True -- {-# SPECIALISE instance Eq (T Int) #-} is fine
InstHeadCtxt -> True -- We check for instance-head InstHeadCtxt -> True -- We check for instance-head
-- formation in checkValidInstHead -- formation in checkValidInstHead
InstThetaCtxt -> undecidable_ok || all tcIsTyVarTy tys InstThetaCtxt -> undecidable_ok || distinct_tyvars tys
other -> gla_exts || all tyvar_head tys other -> gla_exts || all tyvar_head tys
where where
undecidable_ok = dopt Opt_AllowUndecidableInstances dflags undecidable_ok = dopt Opt_AllowUndecidableInstances dflags
gla_exts = dopt Opt_GlasgowExts dflags gla_exts = dopt Opt_GlasgowExts dflags
-------------------------
distinct_tyvars tys -- Check that the types are all distinct type variables
= all tcIsTyVarTy tys && null (findDupsEq tcEqType tys)
------------------------- -------------------------
tyvar_head ty -- Haskell 98 allows predicates of form tyvar_head ty -- Haskell 98 allows predicates of form
| tcIsTyVarTy ty = True -- C (a ty1 .. tyn) | tcIsTyVarTy ty = True -- C (a ty1 .. tyn)
...@@ -1074,7 +1078,8 @@ checkThetaCtxt ctxt theta ...@@ -1074,7 +1078,8 @@ checkThetaCtxt ctxt theta
ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ] ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ]
badSourceTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty badSourceTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
predTyVarErr pred = ptext SLIT("Non-type variables in constraint:") <+> pprPred pred predTyVarErr pred = sep [ptext SLIT("Non-type variables, or repeated type variables,"),
nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)]
dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups) dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
arityErr kind name n m arityErr kind name n m
......
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