@@ -140,9 +140,81 @@ checkExpression arityDict (A.A region expression) =
140140checkPatterns :: ArityDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
141141checkPatterns arityDict region origin patterns =
142142 do matrix <- checkRedundant arityDict region [] patterns
143− if isUseful arityDict matrix [Anything]
144− then Result.throw region (Error.Incomplete origin (error "TODO"))
145− else Result.ok ()
143+ case isExhaustive arityDict matrix 1 of
144+ [] ->
145+ Result.ok ()
146+
147+ badPatterns ->
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+
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
146218
147219
148220checkRedundant
@@ -167,21 +239,6 @@ checkRedundant arityDict region checked unchecked =
167239 Result.throw region (Error.Redundant patRegion (length checked + 1))
168240
169241
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−
185242isUseful :: ArityDict -> [[Pattern]] -> [Pattern] -> Bool
186243isUseful arityDict matrix vector =
187244 case (matrix, vector) of