git.iko.soy/elk
on master help sign in
Figure out which patterns are missing in exhaustiveness check
0c8da23Evan Czaplicki
src/Nitpick/PatternMatches.hs+75−18
compare with master
unifiedsplit
@@ -140,9 +140,81 @@ checkExpression arityDict (A.A region expression) =
140checkPatterns :: ArityDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
140checkPatterns :: ArityDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
141checkPatterns arityDict region origin patterns =
141checkPatterns arityDict region origin patterns =
142 do matrix <- checkRedundant arityDict region [] patterns
142 do matrix <- checkRedundant arityDict region [] patterns
143− if isUseful arityDict matrix [Anything]
143+ case isExhaustive arityDict matrix 1 of
144+ [] ->
145+ Result.ok ()
146+
147+ badPatterns ->
144− then Result.throw region (Error.Incomplete origin (error "TODO"))
148+ Result.throw region (Error.Incomplete origin (map head badPatterns))
149+
150+
151+
152+-- EXHAUSTIVE PATTERNS
153+
154+
155+isExhaustive :: ArityDict -> [[Pattern]] -> Int -> [[Pattern]]
156+isExhaustive arityDict matrix n =
157+ case (matrix, n) of
158+ ([], _) ->
159+ [replicate n Anything]
160+
161+ (_, 0) ->
162+ []
163+
164+ (_, _) ->
165+ let
166+ ctorSet =
167+ List.foldl' isCompleteHelp Set.empty matrix
168+
169+ actual =
170+ Set.size ctorSet
171+ in
172+ if actual == 0 then
173+ (:) Anything
174+ <$> isExhaustive arityDict (Maybe.mapMaybe toDefault matrix) (n - 1)
175+
145− else Result.ok ()
176+ else
177+ let
178+ (ArityInfo expected info) =
179+ getArityInfo (Set.findMin ctorSet) arityDict
180+ in
181+ if actual < expected then
182+ (:)
183+ <$> Maybe.mapMaybe (isMissing ctorSet) info
184+ <*> isExhaustive arityDict (Maybe.mapMaybe toDefault matrix) (n - 1)
185+
186+ else
187+ let
188+ isExhaustiveHelp (name, arity) =
189+ recoverCtor name arity <$>
190+ isExhaustive
191+ arityDict
192+ (Maybe.mapMaybe (specialize name arity) matrix)
193+ (arity + n - 1)
194+ in
195+ concatMap isExhaustiveHelp info
196+
197+
198+isMissing :: Set.Set Var.Canonical -> (Var.Canonical, Int) -> Maybe Pattern
199+isMissing ctorSet (name, arity) =
200+ if Set.member name ctorSet then
201+ Nothing
202+
203+ else
204+ Just (Ctor name (replicate arity Anything))
205+
206+
207+recoverCtor :: Var.Canonical -> Int -> [Pattern] -> [Pattern]
208+recoverCtor name arity patterns =
209+ let
210+ (args, rest) =
211+ splitAt arity patterns
212+ in
213+ Ctor name args : rest
214+
215+
216+
217+-- REDUNDANT PATTERNS
146
218
147
219
148checkRedundant
220checkRedundant
@@ -167,21 +239,6 @@ checkRedundant arityDict region checked unchecked =
167 Result.throw region (Error.Redundant patRegion (length checked + 1))
239 Result.throw region (Error.Redundant patRegion (length checked + 1))
168
240
169
241
170−
171−-- MISSING PATTERNS
172−
173−
174−--missingPatterns :: [[Pattern]] -> Int -> [Pattern]
175−--missingPatterns matrix n =
176−-- case matrix of
177−-- [] ->
178−
179−
180−
181−
182−-- DETECT USEFUL PATTERNS
183−
184−
185isUseful :: ArityDict -> [[Pattern]] -> [Pattern] -> Bool
242isUseful :: ArityDict -> [[Pattern]] -> [Pattern] -> Bool
186isUseful arityDict matrix vector =
243isUseful arityDict matrix vector =
187 case (matrix, vector) of
244 case (matrix, vector) of