@@ -17,7 +17,7 @@ mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
17mistakes decls =
17mistakes decls =
18 concat [ infiniteTypeAliases decls
18 concat [ infiniteTypeAliases decls
19 , illFormedTypes decls
19 , illFormedTypes decls
20− , map P.text (duplicateDataConstructors decls)
20+ , map P.text (duplicateConstructors decls)
21 , map P.text (concatMap findErrors (getLets decls)) ]
21 , map P.text (concatMap findErrors (getLets decls)) ]
23 findErrors defs = duplicates defs ++ badOrder defs
23 findErrors defs = duplicates defs ++ badOrder defs
@@ -47,12 +47,15 @@ duplicates defs =
47 defMsg x = msg ++ "definition of '" ++ x ++ "'."
47 defMsg x = msg ++ "definition of '" ++ x ++ "'."
48 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
48 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
50−duplicateDataConstructors :: [Declaration t v] -> [String]
50+duplicateConstructors :: [Declaration t v] -> [String]
51−duplicateDataConstructors decls = map ctorMsg . dups $ constructors
51+duplicateConstructors decls =
52+ map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)
54+ typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
53− constructors = List.sort . concat $
55+ dataCtors = List.sort . concat $
54 [ map fst patterns | Datatype _ _ patterns <- decls ]
56 [ map fst patterns | Datatype _ _ patterns <- decls ]
57+ dataMsg x = msg ++ "definition of data constructor '" ++ x ++ "'."
55− ctorMsg x = msg ++ "definition of '" ++ x ++ "'."
58+ typeMsg x = msg ++ "definition of type constructor '" ++ x ++ "'."
57badOrder :: [Def t v] -> [String]
60badOrder :: [Def t v] -> [String]
58badOrder defs = go defs
61badOrder defs = go defs