git.iko.soy/elk
on master help sign in
clean up error reporting
d1b3db2Ben Darwin
compiler/Transform/Check.hs+8−7
compare with master
unifiedsplit
@@ -32,20 +32,21 @@ 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−
38dups :: Eq a => [a] -> [a]
35dups :: Eq a => [a] -> [a]
39dups = map head . filter ((>1) . length) . List.group
36dups = map head . filter ((>1) . length) . List.group
40
37
38+dupErr :: String -> String -> String
39+dupErr err x =
40+ "Syntax Error: There can only be one " ++ err ++ " '" ++ x ++ "'."
41+
41duplicates :: [Def t v] -> [String]
42duplicates :: [Def t v] -> [String]
42duplicates defs =
43duplicates defs =
43 map defMsg (dups definitions) ++ map annMsg (dups annotations)
44 map defMsg (dups definitions) ++ map annMsg (dups annotations)
44 where
45 where
45 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
46 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
46 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
47 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
47− defMsg x = msg ++ "definition of '" ++ x ++ "'."
48+ defMsg = dupErr "definition of"
48− annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
49+ annMsg = dupErr "type annotation for"
49
50
50duplicateConstructors :: [Declaration t v] -> [String]
51duplicateConstructors :: [Declaration t v] -> [String]
51duplicateConstructors decls =
52duplicateConstructors decls =
@@ -54,8 +55,8 @@ duplicateConstructors decls =
54 typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
55 typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
55 dataCtors = List.sort . concat $
56 dataCtors = List.sort . concat $
56 [ map fst patterns | Datatype _ _ patterns <- decls ]
57 [ map fst patterns | Datatype _ _ patterns <- decls ]
57− dataMsg x = msg ++ "definition of data constructor '" ++ x ++ "'."
58+ dataMsg = dupErr "definition of data constructor"
58− typeMsg x = msg ++ "definition of type constructor '" ++ x ++ "'."
59+ typeMsg = dupErr "definition of type constructor"
59
60
60badOrder :: [Def t v] -> [String]
61badOrder :: [Def t v] -> [String]
61badOrder defs = go defs
62badOrder defs = go defs