git.iko.soy/elk
on master help sign in
Merge pull request #381 from bcdarwin/master
32d1627Evan Czaplicki
compiler/Transform/Check.hs+18−7
compare with master
unifiedsplit
@@ -17,11 +17,11 @@ 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 (duplicateConstructors decls)
20 , map P.text (concatMap findErrors (getLets decls)) ]
21 , map P.text (concatMap findErrors (getLets decls)) ]
21 where
22 where
22 findErrors defs = duplicates defs ++ badOrder defs
23 findErrors defs = duplicates defs ++ badOrder defs
23
24
24−
25getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
25getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
26getLets decls = defs : concatMap getSubLets defs
26getLets decls = defs : concatMap getSubLets defs
27 where
27 where
@@ -32,6 +32,12 @@ getLets decls = defs : concatMap getSubLets defs
32 Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
32 Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
33 TypeAnnotation _ _ -> []
33 TypeAnnotation _ _ -> []
34
34
35+dups :: Eq a => [a] -> [a]
36+dups = map head . filter ((>1) . length) . List.group
37+
38+dupErr :: String -> String -> String
39+dupErr err x =
40+ "Syntax Error: There can only be one " ++ err ++ " '" ++ x ++ "'."
35
41
36duplicates :: [Def t v] -> [String]
42duplicates :: [Def t v] -> [String]
37duplicates defs =
43duplicates defs =
@@ -39,13 +45,18 @@ duplicates defs =
39 where
45 where
40 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
46 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
41 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
47 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
48+ defMsg = dupErr "definition of"
49+ annMsg = dupErr "type annotation for"
42
50
43− dups = map head . filter ((>1) . length) . List.group
51+duplicateConstructors :: [Declaration t v] -> [String]
44−
52+duplicateConstructors decls =
45− msg = "Syntax Error: There can only be one "
53+ map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)
46− defMsg x = msg ++ "definition of '" ++ x ++ "'."
54+ where
47− annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
55+ typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
48−
56+ dataCtors = List.sort . concat $
57+ [ map fst patterns | Datatype _ _ patterns <- decls ]
58+ dataMsg = dupErr "definition of data constructor"
59+ typeMsg = dupErr "definition of type constructor"
49
60
50badOrder :: [Def t v] -> [String]
61badOrder :: [Def t v] -> [String]
51badOrder defs = go defs
62badOrder defs = go defs