Merge pull request #381 from bcdarwin/master
Add check for duplicate constructors within the same unit
This commit is contained in:
commit
32d162732b
1 changed files with 18 additions and 7 deletions
|
@ -17,11 +17,11 @@ mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
|
||||||
mistakes decls =
|
mistakes decls =
|
||||||
concat [ infiniteTypeAliases decls
|
concat [ infiniteTypeAliases decls
|
||||||
, illFormedTypes decls
|
, illFormedTypes decls
|
||||||
|
, map P.text (duplicateConstructors decls)
|
||||||
, map P.text (concatMap findErrors (getLets decls)) ]
|
, map P.text (concatMap findErrors (getLets decls)) ]
|
||||||
where
|
where
|
||||||
findErrors defs = duplicates defs ++ badOrder defs
|
findErrors defs = duplicates defs ++ badOrder defs
|
||||||
|
|
||||||
|
|
||||||
getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
|
getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
|
||||||
getLets decls = defs : concatMap getSubLets defs
|
getLets decls = defs : concatMap getSubLets defs
|
||||||
where
|
where
|
||||||
|
@ -32,6 +32,12 @@ getLets decls = defs : concatMap getSubLets defs
|
||||||
Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
|
Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
|
||||||
TypeAnnotation _ _ -> []
|
TypeAnnotation _ _ -> []
|
||||||
|
|
||||||
|
dups :: Eq a => [a] -> [a]
|
||||||
|
dups = map head . filter ((>1) . length) . List.group
|
||||||
|
|
||||||
|
dupErr :: String -> String -> String
|
||||||
|
dupErr err x =
|
||||||
|
"Syntax Error: There can only be one " ++ err ++ " '" ++ x ++ "'."
|
||||||
|
|
||||||
duplicates :: [Def t v] -> [String]
|
duplicates :: [Def t v] -> [String]
|
||||||
duplicates defs =
|
duplicates defs =
|
||||||
|
@ -39,13 +45,18 @@ duplicates defs =
|
||||||
where
|
where
|
||||||
annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
|
annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
|
||||||
definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
|
definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
|
||||||
|
defMsg = dupErr "definition of"
|
||||||
|
annMsg = dupErr "type annotation for"
|
||||||
|
|
||||||
dups = map head . filter ((>1) . length) . List.group
|
duplicateConstructors :: [Declaration t v] -> [String]
|
||||||
|
duplicateConstructors decls =
|
||||||
msg = "Syntax Error: There can only be one "
|
map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)
|
||||||
defMsg x = msg ++ "definition of '" ++ x ++ "'."
|
where
|
||||||
annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
|
typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
|
||||||
|
dataCtors = List.sort . concat $
|
||||||
|
[ map fst patterns | Datatype _ _ patterns <- decls ]
|
||||||
|
dataMsg = dupErr "definition of data constructor"
|
||||||
|
typeMsg = dupErr "definition of type constructor"
|
||||||
|
|
||||||
badOrder :: [Def t v] -> [String]
|
badOrder :: [Def t v] -> [String]
|
||||||
badOrder defs = go defs
|
badOrder defs = go defs
|
||||||
|
|
Loading…
Reference in a new issue