+
+
+%************************************************************************
+%* *
+\subsection{Checking a theta or source type}
+%* *
+%************************************************************************
+
+\begin{code}
+-- Enumerate the contexts in which a "source type", <S>, can occur
+-- Eq a
+-- or ?x::Int
+-- or r <: {x::Int}
+-- or (N a) where N is a newtype
+
+data SourceTyCtxt
+ = ClassSCCtxt Name -- Superclasses of clas
+ -- class <S> => C a where ...
+ | SigmaCtxt -- Theta part of a normal for-all type
+ -- f :: <S> => a -> a
+ | DataTyCtxt Name -- Theta part of a data decl
+ -- data <S> => T a = MkT a
+ | TypeCtxt -- Source type in an ordinary type
+ -- f :: N a -> N a
+ | InstThetaCtxt -- Context of an instance decl
+ -- instance <S> => C [a] where ...
+ | InstHeadCtxt -- Head of an instance decl
+ -- instance ... => Eq a where ...
+
+pprSourceTyCtxt (ClassSCCtxt c) = ptext SLIT("the super-classes of class") <+> quotes (ppr c)
+pprSourceTyCtxt SigmaCtxt = ptext SLIT("the context of a polymorphic type")
+pprSourceTyCtxt (DataTyCtxt tc) = ptext SLIT("the context of the data type declaration for") <+> quotes (ppr tc)
+pprSourceTyCtxt InstThetaCtxt = ptext SLIT("the context of an instance declaration")
+pprSourceTyCtxt InstHeadCtxt = ptext SLIT("the head of an instance declaration")
+pprSourceTyCtxt TypeCtxt = ptext SLIT("the context of a type")
+\end{code}
+
+\begin{code}
+checkValidTheta :: SourceTyCtxt -> ThetaType -> TcM ()
+checkValidTheta ctxt theta
+ = addErrCtxt (checkThetaCtxt ctxt theta) (check_valid_theta ctxt theta)
+
+-------------------------
+check_valid_theta ctxt []
+ = returnM ()
+check_valid_theta ctxt theta
+ = getDOpts `thenM` \ dflags ->
+ warnTc (notNull dups) (dupPredWarn dups) `thenM_`
+ -- Actually, in instance decls and type signatures,
+ -- duplicate constraints are eliminated by TcMonoType.hoistForAllTys,
+ -- so this error can only fire for the context of a class or
+ -- data type decl.
+ mappM_ (check_source_ty dflags ctxt) theta
+ where
+ (_,dups) = removeDups tcCmpPred theta
+
+-------------------------
+check_source_ty dflags ctxt pred@(ClassP cls tys)
+ = -- Class predicates are valid in all contexts
+ mappM_ check_arg_type tys `thenM_`
+ checkTc (arity == n_tys) arity_err `thenM_`
+ checkTc (check_class_pred_tys dflags ctxt tys)
+ (predTyVarErr pred $$ how_to_allow)
+
+ where
+ class_name = className cls
+ arity = classArity cls
+ n_tys = length tys
+ arity_err = arityErr "Class" class_name arity n_tys
+
+ how_to_allow = case ctxt of
+ InstHeadCtxt -> empty -- Should not happen
+ InstThetaCtxt -> parens undecidableMsg
+ other -> parens (ptext SLIT("Use -fglasgow-exts to permit this"))
+
+check_source_ty dflags SigmaCtxt (IParam _ ty) = check_arg_type ty
+ -- Implicit parameters only allows in type
+ -- signatures; not in instance decls, superclasses etc
+ -- The reason for not allowing implicit params in instances is a bit subtle
+ -- If we allowed instance (?x::Int, Eq a) => Foo [a] where ...
+ -- then when we saw (e :: (?x::Int) => t) it would be unclear how to
+ -- discharge all the potential usas of the ?x in e. For example, a
+ -- constraint Foo [Int] might come out of e,and applying the
+ -- instance decl would show up two uses of ?x.
+
+check_source_ty dflags TypeCtxt (NType tc tys) = mappM_ check_arg_type tys
+
+-- Catch-all
+check_source_ty dflags ctxt sty = failWithTc (badSourceTyErr sty)
+
+-------------------------
+check_class_pred_tys dflags ctxt tys
+ = case ctxt of
+ InstHeadCtxt -> True -- We check for instance-head
+ -- formation in checkValidInstHead
+ InstThetaCtxt -> undecidable_ok || all isTyVarTy tys
+ other -> gla_exts || all tyvar_head tys
+ where
+ undecidable_ok = dopt Opt_AllowUndecidableInstances dflags
+ gla_exts = dopt Opt_GlasgowExts dflags
+
+-------------------------
+tyvar_head ty -- Haskell 98 allows predicates of form
+ | tcIsTyVarTy ty = True -- C (a ty1 .. tyn)
+ | otherwise -- where a is a type variable
+ = case tcSplitAppTy_maybe ty of
+ Just (ty, _) -> tyvar_head ty
+ Nothing -> False
+\end{code}
+