X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcMType.lhs;h=02eba6dde5b89afb41b53732a3062df783ae0406;hb=25bff7fe1a22edbafa188af8d844c67057fa5eb8;hp=d45d774cda04d6ba1818315cabd9ed9e2d7088f1;hpb=a40f2735958055f7ff94e5df73e710044aa63b2c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index d45d774..02eba6d 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -1135,10 +1135,12 @@ check_pred_ty dflags ctxt pred@(ClassP cls tys)
     how_to_allow = parens (ptext (sLit "Use -XFlexibleContexts to permit this"))
 
 
-check_pred_ty dflags _ pred@(EqPred ty1 ty2)
+check_pred_ty dflags ctxt pred@(EqPred ty1 ty2)
   = do {	-- Equational constraints are valid in all contexts if type
 		-- families are permitted
        ; checkTc (xopt Opt_TypeFamilies dflags) (eqPredTyErr pred)
+       ; checkTc (case ctxt of ClassSCCtxt {} -> False; _ -> True)
+                 (eqSuperClassErr pred)
 
 		-- Check the form of the argument types
        ; checkValidMonoType ty1
@@ -1295,11 +1297,16 @@ checkThetaCtxt ctxt theta
   = vcat [ptext (sLit "In the context:") <+> pprTheta theta,
 	  ptext (sLit "While checking") <+> pprSourceTyCtxt ctxt ]
 
+eqSuperClassErr :: PredType -> SDoc
+eqSuperClassErr pred
+  = hang (ptext (sLit "Alas, GHC 7.0 still cannot handle equality superclasses:"))
+       2 (ppr pred)
+
 badPredTyErr, eqPredTyErr, predTyVarErr :: PredType -> SDoc
-badPredTyErr sty = ptext (sLit "Illegal constraint") <+> pprPred sty
-eqPredTyErr  sty = ptext (sLit "Illegal equational constraint") <+> pprPred sty
-		   $$
-		   parens (ptext (sLit "Use -XTypeFamilies to permit this"))
+badPredTyErr pred = ptext (sLit "Illegal constraint") <+> pprPred pred
+eqPredTyErr  pred = ptext (sLit "Illegal equational constraint") <+> pprPred pred
+		    $$
+		    parens (ptext (sLit "Use -XTypeFamilies to permit this"))
 predTyVarErr pred  = sep [ptext (sLit "Non type-variable argument"),
 			  nest 2 (ptext (sLit "in the constraint:") <+> pprPred pred)]
 dupPredWarn :: [[PredType]] -> SDoc