From: simonpj <unknown>
Date: Mon, 4 Oct 2004 09:35:08 +0000 (+0000)
Subject: [project @ 2004-10-04 09:35:08 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~1533
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=3b7d2756979023bd5244ea2a448237e091405db6;p=ghc-hetmet.git

[project @ 2004-10-04 09:35:08 by simonpj]
Sort decls in cycle for error message
---

diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
index 295b259..e4bc357 100644
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyClsDecls.lhs
@@ -49,7 +49,7 @@ import Var		( TyVar, idType, idName )
 import VarSet		( elemVarSet )
 import Name		( Name )
 import Outputable
-import Util		( zipLazy, isSingleton, notNull )
+import Util		( zipLazy, isSingleton, notNull, sortLe )
 import List		( partition )
 import SrcLoc		( Located(..), unLoc, getLoc )
 import ListSetOps	( equivClasses )
@@ -683,19 +683,26 @@ badGenericMethodType op op_ty
 		ptext SLIT("You can only use type variables, arrows, and tuples")])
 
 recSynErr syn_decls
-  = setSrcSpan (getLoc (head syn_decls)) $
+  = setSrcSpan (getLoc (head sorted_decls)) $
     addErr (sep [ptext SLIT("Cycle in type synonym declarations:"),
-		 nest 2 (vcat (map ppr_decl syn_decls))])
+		 nest 2 (vcat (map ppr_decl sorted_decls))])
   where
+    sorted_decls = sortLocated syn_decls
     ppr_decl (L loc decl) = ppr loc <> colon <+> ppr decl
 
 recClsErr cls_decls
-  = setSrcSpan (getLoc (head cls_decls)) $
+  = setSrcSpan (getLoc (head sorted_decls)) $
     addErr (sep [ptext SLIT("Cycle in class declarations (via superclasses):"),
-		 nest 2 (vcat (map ppr_decl cls_decls))])
+		 nest 2 (vcat (map ppr_decl sorted_decls))])
   where
+    sorted_decls = sortLocated cls_decls
     ppr_decl (L loc decl) = ppr loc <> colon <+> ppr (decl { tcdSigs = [] })
 
+sortLocated :: [Located a] -> [Located a]
+sortLocated things = sortLe le things
+  where
+    le (L l1 _) (L l2 _) = l1 <= l2
+
 exRecConErr name
   = ptext SLIT("Can't combine named fields with locally-quantified type variables or context")
     $$