Tweak the undecidable-instance-checking logic

[ghc-hetmet.git] / compiler / typecheck / TcMType.lhs

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index c34387b..9746e0c 100644 (file)
--- 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