newTyVar,
newTyVarTy, -- Kind -> TcM TcType
newTyVarTys, -- Int -> Kind -> TcM [TcType]
- newKindVar, newKindVars, newBoxityVar,
+ newKindVar, newKindVars, newOpenTypeKind,
putTcTyVar, getTcTyVar,
newMutTyVar, readMutTyVar, writeMutTyVar,
-- friends:
import TypeRep ( Type(..), SourceType(..), TyNote(..), -- Friend; can see representation
- Kind, ThetaType
+ Kind, ThetaType, typeCon
)
import TcType ( TcType, TcThetaType, TcTauType, TcPredType,
TcTyVarSet, TcKind, TcTyVar, TyVarDetails(..),
- tcEqType, tcCmpPred,
+ tcEqType, tcCmpPred, isClassPred,
tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
tcSplitTyConApp_maybe, tcSplitForAllTys,
- tcIsTyVarTy, tcSplitSigmaTy,
+ tcIsTyVarTy, tcSplitSigmaTy, mkTyConApp,
isUnLiftedType, isIPPred, isHoleTyVar, isTyVarTy,
mkAppTy, mkTyVarTy, mkTyVarTys,
eqKind, isTypeKind,
isFFIArgumentTy, isFFIImportResultTy
)
-import qualified Type ( splitFunTys )
import Subst ( Subst, mkTopTyVarSubst, substTy )
import Class ( Class, DefMeth(..), classArity, className, classBigSig )
import TyCon ( TyCon, isSynTyCon, isUnboxedTupleTyCon,
- tyConArity, tyConName, tyConKind, tyConTheta,
+ tyConArity, tyConName, tyConTheta,
getSynTyConDefn, tyConDataCons )
import DataCon ( DataCon, dataConWrapId, dataConName, dataConSig, dataConFieldLabels )
import FieldLabel ( fieldLabelName, fieldLabelType )
import ForeignCall ( Safety(..) )
import FunDeps ( grow )
import PprType ( pprPred, pprSourceType, pprTheta, pprClassPred )
-import Name ( Name, NamedThing(..), setNameUnique,
- mkSystemTvNameEncoded,
- )
+import Name ( Name, setNameUnique, mkSystemTvNameEncoded )
import VarSet
-import BasicTypes ( Boxity(Boxed) )
import CmdLineOpts ( dopt, DynFlag(..) )
-import SrcLoc ( noSrcLoc )
import Util ( nOfThem, isSingleton, equalLength, notNull )
import ListSetOps ( equivClasses, removeDups )
import Outputable
newKindVars :: Int -> TcM [TcKind]
newKindVars n = mappM (\ _ -> newKindVar) (nOfThem n ())
-newBoxityVar :: TcM TcKind
-newBoxityVar
+newOpenTypeKind :: TcM TcKind -- Returns the kind (Type bx), where bx is fresh
+newOpenTypeKind
= newUnique `thenM` \ uniq ->
newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("bx")) superBoxity VanillaTv `thenM` \ kv ->
- returnM (TyVarTy kv)
+ returnM (mkTyConApp typeCon [TyVarTy kv])
\end{code}
where
complain pred = addErrTc (ambigErr pred)
extended_tau_vars = grow theta tau_tyvars
- is_ambig pred = any ambig_var (varSetElems (tyVarsOfPred pred))
+
+ -- Only a *class* predicate can give rise to ambiguity
+ -- An *implicit parameter* cannot. For example:
+ -- foo :: (?x :: [a]) => Int
+ -- foo = length ?x
+ -- is fine. The call site will suppply a particular 'x'
+ is_ambig pred = isClassPred pred &&
+ any ambig_var (varSetElems (tyVarsOfPred pred))
ambig_var ct_var = (ct_var `elem` forall_tyvars) &&
not (ct_var `elemVarSet` extended_tau_vars)
- is_free ct_var = not (ct_var `elem` forall_tyvars)
-
ambigErr pred
= sep [ptext SLIT("Ambiguous constraint") <+> quotes (pprPred pred),
nest 4 (ptext SLIT("At least one of the forall'd type variables mentioned by the constraint") $$
-- This checks the argument types and
-- ambiguity of the existential context (if any)
addErrCtxt (existentialCtxt con)
- (checkFreeness ex_tvs ex_theta)
+ (checkFreeness ex_tvs ex_theta)
where
ctxt = ConArgCtxt (dataConName con)
(_, _, ex_tvs, ex_theta, _, _) = dataConSig con