[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 (file)
--- 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")
     $$