yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #381 from bcdarwin/master

Browse source 
Add check for duplicate constructors within the same unit
This commit is contained in:
Evan Czaplicki 2013-12-10 17:48:06 -08:00
commit 32d162732b
1 changed files with 18 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
compiler/Transform/Check.hs
View file

@ -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