tcSkolSigTyVars info tyvars = [ mkSkolTyVar (tyVarName tv) (tyVarKind tv) info
| tv <- tyvars ]
-tcInstSkolTyVar :: SkolemInfo -> Maybe SrcLoc -> TyVar -> TcM TcTyVar
+tcInstSkolTyVar :: SkolemInfo -> Maybe SrcSpan -> TyVar -> TcM TcTyVar
-- Instantiate the tyvar, using
-- * the occ-name and kind of the supplied tyvar,
-- * the unique from the monad,
= do { uniq <- newUnique
; let old_name = tyVarName tyvar
kind = tyVarKind tyvar
- loc = mb_loc `orElse` getSrcLoc old_name
+ loc = mb_loc `orElse` getSrcSpan old_name
new_name = mkInternalName uniq (nameOccName old_name) loc
; return (mkSkolTyVar new_name kind info) }
-- Get the location from the monad
tcInstSkolTyVars info tyvars
= do { span <- getSrcSpanM
- ; mapM (tcInstSkolTyVar info (Just (srcSpanStart span))) tyvars }
+ ; mapM (tcInstSkolTyVar info (Just span)) tyvars }
tcInstSkolType :: SkolemInfo -> TcType -> TcM ([TcTyVar], TcThetaType, TcType)
-- Instantiate a type with fresh skolem constants
returnM (tyVarsOfTypes tys)
zonkTcTyVar :: TcTyVar -> TcM TcType
-zonkTcTyVar tyvar = ASSERT( isTcTyVar tyvar )
+zonkTcTyVar tyvar = ASSERT2( isTcTyVar tyvar, ppr tyvar)
zonk_tc_tyvar (\ tv -> returnM (TyVarTy tv)) tyvar
\end{code}
checkValidType ctxt ty
= traceTc (text "checkValidType" <+> ppr ty) `thenM_`
doptM Opt_GlasgowExts `thenM` \ gla_exts ->
+ doptM Opt_Rank2Types `thenM` \ rank2 ->
+ doptM Opt_RankNTypes `thenM` \ rankn ->
+ doptM Opt_PolymorphicComponents `thenM` \ polycomp ->
let
- rank | gla_exts = Arbitrary
+ rank | rankn = Arbitrary
+ | rank2 = Rank 2
| otherwise
= case ctxt of -- Haskell 98
GenPatCtxt -> Rank 0
TySynCtxt _ -> Rank 0
ExprSigCtxt -> Rank 1
FunSigCtxt _ -> Rank 1
- ConArgCtxt _ -> Rank 1 -- We are given the type of the entire
- -- constructor, hence rank 1
+ ConArgCtxt _ -> if polycomp
+ then Rank 2
+ -- We are given the type of the entire
+ -- constructor, hence rank 1
+ else Rank 1
ForSigCtxt _ -> Rank 1
SpecInstCtxt -> Rank 1
arity = classArity cls
n_tys = length tys
arity_err = arityErr "Class" class_name arity n_tys
- how_to_allow = parens (ptext SLIT("Use -fglasgow-exts to permit this"))
+ how_to_allow = parens (ptext SLIT("Use -XFlexibleContexts to permit this"))
check_pred_ty dflags ctxt pred@(EqPred ty1 ty2)
- = do { -- Equational constraints are valid in all contexts if indexed
- -- types are permitted
- ; checkTc (dopt Opt_IndexedTypes dflags) (eqPredTyErr pred)
+ = do { -- Equational constraints are valid in all contexts if type
+ -- families are permitted
+ ; checkTc (dopt Opt_TypeFamilies dflags) (eqPredTyErr pred)
-- Check the form of the argument types
; check_eq_arg_type ty1
check_class_pred_tys dflags ctxt tys
= case ctxt of
TypeCtxt -> True -- {-# SPECIALISE instance Eq (T Int) #-} is fine
- InstThetaCtxt -> gla_exts || undecidable_ok || all tcIsTyVarTy tys
+ InstThetaCtxt -> flexible_contexts || undecidable_ok || all tcIsTyVarTy tys
-- Further checks on head and theta in
-- checkInstTermination
- other -> gla_exts || all tyvar_head tys
+ other -> flexible_contexts || all tyvar_head tys
where
- gla_exts = dopt Opt_GlasgowExts dflags
+ flexible_contexts = dopt Opt_FlexibleContexts dflags
undecidable_ok = dopt Opt_AllowUndecidableInstances dflags
-------------------------
\begin{code}
checkFreeness forall_tyvars theta
- = do { gla_exts <- doptM Opt_GlasgowExts
- ; if gla_exts then return () -- New! Oct06
- else mappM_ complain (filter is_free theta) }
+ = do { flexible_contexts <- doptM Opt_FlexibleContexts
+ ; unless flexible_contexts $ mappM_ complain (filter is_free theta) }
where
is_free pred = not (isIPPred pred)
&& not (any bound_var (varSetElems (tyVarsOfPred pred)))
badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
eqPredTyErr sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty
$$
- parens (ptext SLIT("Use -findexed-types to permit this"))
+ parens (ptext SLIT("Use -ftype-families to permit this"))
predTyVarErr pred = sep [ptext SLIT("Non type-variable argument"),
nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)]
dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
check_inst_head dflags clas tys
-- If GlasgowExts then check at least one isn't a type variable
- | dopt Opt_GlasgowExts dflags
- = mapM_ check_one tys
-
- -- WITH HASKELL 98, MUST HAVE C (T a b c)
- | otherwise
- = checkTc (isSingleton tys && tcValidInstHeadTy first_ty)
- (instTypeErr (pprClassPred clas tys) head_shape_msg)
-
+ = do checkTc (dopt Opt_TypeSynonymInstances dflags ||
+ all tcInstHeadTyNotSynonym tys)
+ (instTypeErr (pprClassPred clas tys) head_type_synonym_msg)
+ checkTc (dopt Opt_FlexibleInstances dflags ||
+ all tcInstHeadTyAppAllTyVars tys)
+ (instTypeErr (pprClassPred clas tys) head_type_args_tyvars_msg)
+ checkTc (dopt Opt_MultiParamTypeClasses dflags ||
+ isSingleton tys)
+ (instTypeErr (pprClassPred clas tys) head_one_type_msg)
+ mapM_ check_one tys
where
- (first_ty : _) = tys
+ head_type_synonym_msg = parens (
+ text "All instance types must be of the form (T t1 ... tn)" $$
+ text "where T is not a synonym." $$
+ text "Use -XTypeSynonymInstances if you want to disable this.")
+
+ head_type_args_tyvars_msg = parens (
+ text "All instance types must be of the form (T a1 ... an)" $$
+ text "where a1 ... an are distinct type *variables*" $$
+ text "Use -XFlexibleInstances if you want to disable this.")
- head_shape_msg = parens (text "The instance type must be of form (T a1 ... an)" $$
- text "where T is not a synonym, and a1 ... an are distinct type variables")
+ head_one_type_msg = parens (
+ text "Only one type can be given in an instance head." $$
+ text "Use -XMultiParamTypeClasses if you want to allow more.")
-- For now, I only allow tau-types (not polytypes) in
-- the head of an instance decl.
undecidableMsg])
\end{code}
-Termination test: each assertion in the context satisfies
+Termination test: the so-called "Paterson conditions" (see Section 5 of
+"Understanding functionsl dependencies via Constraint Handling Rules,
+JFP Jan 2007).
+
+We check that each assertion in the context satisfies:
(1) no variable has more occurrences in the assertion than in the head, and
(2) the assertion has fewer constructors and variables (taken together
and counting repetitions) than the head.