git.iko.soy/elk
on master help sign in
fix duplicate *data* constructors
36b73feBen Darwin
compiler/Transform/Check.hs+12−5
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 (duplicateDataConstructors 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,11 @@ 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+msg :: String
36+msg = "Syntax Error: There can only be one "
37+
38+dups :: Eq a => [a] -> [a]
39+dups = map head . filter ((>1) . length) . List.group
35
40
36duplicates :: [Def t v] -> [String]
41duplicates :: [Def t v] -> [String]
37duplicates defs =
42duplicates defs =
@@ -39,13 +44,15 @@ duplicates defs =
39 where
44 where
40 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
45 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
41 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
46 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
42−
43− dups = map head . filter ((>1) . length) . List.group
44−
45− msg = "Syntax Error: There can only be one "
46 defMsg x = msg ++ "definition of '" ++ x ++ "'."
47 defMsg x = msg ++ "definition of '" ++ x ++ "'."
47 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
48 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
48
49
50+duplicateDataConstructors :: [Declaration t v] -> [String]
51+duplicateDataConstructors decls = map ctorMsg . dups $ constructors
52+ where
53+ constructors = List.sort . concat $
54+ [ map fst patterns | Datatype _ _ patterns <- decls ]
55+ ctorMsg x = msg ++ "definition of '" ++ x ++ "'."
49
56
50badOrder :: [Def t v] -> [String]
57badOrder :: [Def t v] -> [String]
51badOrder defs = go defs
58badOrder defs = go defs