git.iko.soy/elk
on master help sign in
Solve a "non-exhaustive pattern match"
a9de234evancz
compiler/Types/Alias.hs+21−24
compare with master
unifiedsplit
@@ -49,15 +49,8 @@ dealias aliases t =
49 RecordT r t -> RecordT (Map.map (map f) r) (f t)
49 RecordT r t -> RecordT (Map.map (map f) r) (f t)
50 _ -> t
50 _ -> t
51
51
52−--mistakes :: [Def t v] -> [String]
52+mistakes :: (Data t, Data v) => [Declaration t v] -> [String]
53−mistakes defs = badKinds defs -- ++ dups defs ++ badOrder defs
53+mistakes decls = badKinds decls ++ dups decls ++ badOrder decls
54−
55−extractDefs :: [Declaration t v] -> [Def t v]
56−extractDefs = concatMap keepDef
57− where
58− keepDef decl = case decl of
59− Definition def -> [def]
60− _ -> []
61
54
62badKinds :: (Data t, Data v) => [Declaration t v] -> [String]
55badKinds :: (Data t, Data v) => [Declaration t v] -> [String]
63badKinds decls = map msg (concatMap bad decls)
56badKinds decls = map msg (concatMap bad decls)
@@ -66,7 +59,7 @@ badKinds decls = map msg (concatMap bad decls)
66 "' was given the wrong number of arguments."
59 "' was given the wrong number of arguments."
67
60
68 aliases :: AliasDict
61 aliases :: AliasDict
69− aliases = Map.empty
62+ aliases = get decls
70
63
71 badType :: Type -> [String]
64 badType :: Type -> [String]
72 badType t =
65 badType t =
@@ -107,32 +100,34 @@ annotation s =
107definition :: Declaration t v -> [String]
100definition :: Declaration t v -> [String]
108definition s =
101definition s =
109 case s of
102 case s of
110− Definition d -> [defName d]
103+ Definition d -> defName d
111 _ -> []
104 _ -> []
112
105
113−defName :: Def t v -> String
106+defName :: Def t v -> [String]
114defName d =
107defName d =
115 case d of
108 case d of
116− FnDef n _ _ -> n
109+ FnDef n _ _ -> [n]
117− OpDef n _ _ _ -> n
110+ OpDef n _ _ _ -> [n]
111+ _ -> []
118
112
119dups :: [Declaration t v] -> [String]
113dups :: [Declaration t v] -> [String]
120−dups defs = map defMsg (dup definition) ++ map annMsg (dup annotation)
114+dups decls = map defMsg (dup definition) ++ map annMsg (dup annotation)
121 where
115 where
122 --dup :: (Declaration t v -> [String]) -> [String]
116 --dup :: (Declaration t v -> [String]) -> [String]
123− dup f = map head . filter ((>1) . length) . group . sort $ concatMap f defs
117+ dup f = map head . filter ((>1) . length) . group . sort $ concatMap f decls
124
118
125 msg = "Syntax Error: There can only be one "
119 msg = "Syntax Error: There can only be one "
126 defMsg x = msg ++ "top-level definition of '" ++ x ++ "'."
120 defMsg x = msg ++ "top-level definition of '" ++ x ++ "'."
127 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
121 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
128
122
129−--badOrder :: [Def t v] -> [String]
123+badOrder :: (Data t, Data v) => [Declaration t v] -> [String]
124+badOrder decls =
130−badOrder defs = map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPairs defs)
125+ map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPairs decls)
131 where
126 where
132 msg x = "Syntax Error: The type annotation for '" ++ x ++
127 msg x = "Syntax Error: The type annotation for '" ++ x ++
133 "' must be directly above its definition."
128 "' must be directly above its definition."
134− as = sort $ concatMap annotation defs
129+ as = sort $ concatMap annotation decls
135− ds = sort $ concatMap definition defs
130+ ds = sort $ concatMap definition decls
136
131
137 expectedPairs :: [String] -> [String] -> [String]
132 expectedPairs :: [String] -> [String] -> [String]
138 expectedPairs as ds =
133 expectedPairs as ds =
@@ -144,10 +139,12 @@ badOrder defs = map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPa
144 ( _ , _ ) -> []
139 ( _ , _ ) -> []
145
140
146 --actualPairs :: [Def t v] -> [String]
141 --actualPairs :: [Def t v] -> [String]
147− actualPairs defs =
142+ actualPairs decls =
148− case defs of
143+ case decls of
149− Definition (TypeAnnotation n _) : Definition d : rest ->
144+ Definition (TypeAnnotation n _) : Definition (FnDef m _ _) : rest ->
145+ (if n == m then [n] else []) ++ actualPairs rest
146+ Definition (TypeAnnotation n _) : Definition (OpDef m _ _ _) : rest ->
150− (if n == defName d then [n] else []) ++ actualPairs rest
147+ (if n == m then [n] else []) ++ actualPairs rest
151 t:s:rest -> actualPairs (s:rest)
148 t:s:rest -> actualPairs (s:rest)
152 _ -> []
149 _ -> []
153
150