git.iko.soy/elk
on master help sign in
Simplify code to check for structural errors
7b90975Evan Czaplicki
compiler/Transform/Check.hs+17−44
compare with master
unifiedsplit
@@ -13,9 +13,8 @@ import Text.PrettyPrint as P
13
13
14mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
14mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
15mistakes decls =
15mistakes decls =
16− map prettify $ concatMap findErrors (getLets decls)
16+ map P.text $ concatMap findErrors (getLets decls)
17 where
17 where
18− prettify = P.sep . map P.text . words
19 findErrors defs = duplicates defs ++ badOrder defs
18 findErrors defs = duplicates defs ++ badOrder defs
20
19
21
20
@@ -32,9 +31,12 @@ getLets decls = defs : concatMap getSubLets defs
32
31
33duplicates :: [Def t v] -> [String]
32duplicates :: [Def t v] -> [String]
34duplicates defs =
33duplicates defs =
35− map defMsg (dup definition) ++ map annMsg (dup annotation)
34+ map defMsg (dups definitions) ++ map annMsg (dups annotations)
36 where
35 where
36+ annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
37+ definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
38+
37− dup f = map head . filter ((>1) . length) . List.group . List.sort $ concatMap f defs
39+ dups = map head . filter ((>1) . length) . List.group
38
40
39 msg = "Syntax Error: There can only be one "
41 msg = "Syntax Error: There can only be one "
40 defMsg x = msg ++ " definition of '" ++ x ++ "'."
42 defMsg x = msg ++ " definition of '" ++ x ++ "'."
@@ -42,49 +44,20 @@ duplicates defs =
42
44
43
45
44badOrder :: [Def t v] -> [String]
46badOrder :: [Def t v] -> [String]
45−badOrder defs =
47+badOrder defs = go defs
46− map msg $ missings (List.sort $ expectedPairs as ds) (List.sort $ actualPairs defs)
47 where
48 where
48 msg x = "Syntax Error: The type annotation for '" ++ x ++
49 msg x = "Syntax Error: The type annotation for '" ++ x ++
49 "' must be directly above its definition."
50 "' must be directly above its definition."
50− as = List.sort $ concatMap annotation defs
51+
51− ds = List.sort $ concatMap definition defs
52+ go defs =
52−
53− expectedPairs :: [String] -> [String] -> [String]
54− expectedPairs as ds =
55− case (as,ds) of
56− (x:xs, y:ys) -> case compare x y of
57− LT -> expectedPairs xs (y:ys)
58− EQ -> x : expectedPairs xs ys
59− GT -> expectedPairs (x:xs) ys
60− ( _ , _ ) -> []
61−
62− actualPairs defs =
63 case defs of
53 case defs of
64− TypeAnnotation name _ : Def (PVar name') _ : rest ->
54+ TypeAnnotation name _ : Def (PVar name') _ : rest
65− (if name == name' then [name] else []) ++ actualPairs rest
55+ | name == name' -> go rest
56+
57+ TypeAnnotation name _ : rest -> [msg name] ++ go rest
58+
66− t:s:rest -> actualPairs (s:rest)
59+ _ : rest -> go rest
60+
67 _ -> []
61 _ -> []
68
62
69− missings :: [String] -> [String] -> [String]
63+
70− missings expected actual =
71− case (expected, actual) of
72− (e:es, a:as) -> case compare e a of
73− LT -> e : missings es (a:as)
74− EQ -> missings es as
75− GT -> a : missings (e:es) as
76− ( [] , _ ) -> actual
77− ( _ , [] ) -> expected
78−
79−
80−annotation :: Def t v -> [String]
81−annotation def =
82− case def of
83− TypeAnnotation name _ -> [name]
84− _ -> []
85−
86−definition :: Def t v -> [String]
87−definition def =
88− case def of
89− Def pattern _ -> Set.toList (boundVars pattern)
90− _ -> []