X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypecheck%2FTcMType.lhs;h=9746e0cbde2bc7e554b2c47ab69b178f82d56537;hb=a4980c2c58727d4337b48b7e4a7dcd4747d0fec7;hp=c34387b99bfbdf6be55858887cd92912cd2cd6c9;hpb=f109a0b2d927a8c7fe5cc9881f0dfdae3e34f399;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index c34387b..9746e0c 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -838,10 +838,9 @@ check_tau_type rank ubx_tup ty@(TyConApp tc tys) && tyConArity tc <= length tys) $ failWithTc arity_msg - ; gla_exts <- doptM Opt_GlasgowExts - ; if gla_exts && not (isOpenTyCon tc) then - -- If -fglasgow-exts then don't check the type arguments of - -- *closed* synonyms. + ; ok <- doptM Opt_PartiallyAppliedClosedTypeSynonyms + ; if ok && not (isOpenTyCon tc) then + -- Don't check the type arguments of *closed* synonyms. -- This allows us to instantiate a synonym defn with a -- for-all type, or with a partially-applied type synonym. -- e.g. type T a b = a @@ -947,7 +946,7 @@ check_pred_ty dflags ctxt pred@(ClassP cls tys) 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 type @@ -979,12 +978,12 @@ check_pred_ty dflags ctxt sty = failWithTc (badPredTyErr sty) 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 ------------------------- @@ -1058,9 +1057,8 @@ even in a scope where b is in scope. \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))) @@ -1181,15 +1179,15 @@ instTypeErr pp_ty msg \begin{code} checkValidInstance :: [TyVar] -> ThetaType -> Class -> [TcType] -> TcM () checkValidInstance tyvars theta clas inst_tys - = do { gla_exts <- doptM Opt_GlasgowExts - ; undecidable_ok <- doptM Opt_AllowUndecidableInstances + = do { undecidable_ok <- doptM Opt_AllowUndecidableInstances ; checkValidTheta InstThetaCtxt theta ; checkAmbiguity tyvars theta (tyVarsOfTypes inst_tys) -- Check that instance inference will terminate (if we care) - -- For Haskell 98, checkValidTheta has already done that - ; when (gla_exts && not undecidable_ok) $ + -- For Haskell 98 this will already have been done by checkValidTheta, + -- but as we may be using other extensions we need to check. + ; unless undecidable_ok $ mapM_ addErrTc (checkInstTermination inst_tys theta) -- The Coverage Condition