Reject programs with equality superclasses for now

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index d45d774..02eba6d 100644 (file)
--- 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