From: simonpj@microsoft.com <unknown>
Date: Tue, 19 Oct 2010 09:01:40 +0000 (+0000)
Subject: Reject programs with equality superclasses for now
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=723365de1b9ab1b8a8cf59a936624891d075e554

Reject programs with equality superclasses for now
---

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