From e34157d4abd4b82d9b5c32035946edcd22c235b6 Mon Sep 17 00:00:00 2001
From: Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Date: Fri, 7 Sep 2007 10:19:01 +0000
Subject: [PATCH] Improved error messages for higher-rank equality contexts

---
 compiler/typecheck/TcMType.lhs |   13 ++++++++-----
 compiler/types/TypeRep.lhs     |   22 +++++++++++++++-------
 2 files changed, 23 insertions(+), 12 deletions(-)

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index c574820..1ae1b2b 100644
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -1071,10 +1071,13 @@ checkFreeness forall_tyvars theta
     complain pred    = addErrTc (freeErr pred)
 
 freeErr pred
-  = sep [ptext SLIT("All of the type variables in the constraint") <+> quotes (pprPred pred) <+>
-		   ptext SLIT("are already in scope"),
-	 nest 4 (ptext SLIT("(at least one must be universally quantified here)"))
-    ]
+  = sep [ ptext SLIT("All of the type variables in the constraint") <+> 
+          quotes (pprPred pred)
+	, ptext SLIT("are already in scope") <+>
+          ptext SLIT("(at least one must be universally quantified here)")
+	, nest 4 $
+            ptext SLIT("(Use -XFlexibleContexts to lift this restriction)")
+        ]
 \end{code}
 
 \begin{code}
@@ -1085,7 +1088,7 @@ checkThetaCtxt ctxt theta
 badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
 eqPredTyErr  sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty
 		   $$
-		   parens (ptext SLIT("Use -ftype-families to permit this"))
+		   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 dups   = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index a3a46b3..1b2f56d 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -501,14 +501,22 @@ ppr_type p (FunTy ty1 ty2)
 ppr_forall_type :: Prec -> Type -> SDoc
 ppr_forall_type p ty
   = maybeParen p FunPrec $
-    sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
+    sep [pprForAll tvs, pprThetaArrow (ctxt1 ++ ctxt2), pprType tau]
   where
-    (tvs,  rho) = split1 [] ty
-    (ctxt, tau) = split2 [] rho
-
-    split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
-    split1 tvs (NoteTy _ ty)    = split1 tvs ty
-    split1 tvs ty		= (reverse tvs, ty)
+    (tvs, ctxt1, rho) = split1 [] [] ty
+    (ctxt2, tau)      = split2 [] rho
+
+    -- We need to be extra careful here as equality constraints will occur as
+    -- type variables with an equality kind.  So, while collecting quantified
+    -- variables, we separate the coercion variables out and turn them into
+    -- equality predicates.
+    split1 tvs eqs (ForAllTy tv ty) 
+      | isCoVar tv               = split1 tvs (eq:eqs) ty
+      | otherwise                = split1 (tv:tvs) eqs ty
+      where
+        PredTy eq = tyVarKind tv
+    split1 tvs eqs (NoteTy _ ty) = split1 tvs eqs ty
+    split1 tvs eqs ty		 = (reverse tvs, reverse eqs, ty)
  
     split2 ps (NoteTy _ arg 	-- Rather a disgusting case
 	       `FunTy` res) 	      = split2 ps (arg `FunTy` res)
-- 
1.7.10.4