git.iko.soy/elk
on master help sign in
Speed up exhaustiveness checker.
a3ef05fBrian Hempel
src/Nitpick/Pattern.hs+1−1
compare with master
unifiedsplit
@@ -17,7 +17,7 @@ data Pattern
17 | Anything
17 | Anything
18 | Literal L.Literal
18 | Literal L.Literal
19 | AnythingBut (Set.Set L.Literal)
19 | AnythingBut (Set.Set L.Literal)
20− deriving (Eq)
20+ deriving (Eq, Ord)
21
21
22
22
23fromCanonicalPattern :: P.Canonical -> Pattern
23fromCanonicalPattern :: P.Canonical -> Pattern
src/Nitpick/PatternMatches.hs+12−11
@@ -209,25 +209,25 @@ checkExpression tagDict (A.A region expression) =
209
209
210checkPatterns :: TagDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
210checkPatterns :: TagDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
211checkPatterns tagDict region origin patterns =
211checkPatterns tagDict region origin patterns =
212− checkPatternsHelp tagDict region origin [Anything] patterns
212+ checkPatternsHelp tagDict region origin (Set.singleton Anything) patterns
213
213
214
214
215checkPatternsHelp
215checkPatternsHelp
216 :: TagDict
216 :: TagDict
217 -> Region.Region
217 -> Region.Region
218 -> Error.Origin
218 -> Error.Origin
219− -> [Pattern]
219+ -> Set.Set Pattern
220 -> [Pattern.Canonical]
220 -> [Pattern.Canonical]
221 -> Result wrn ()
221 -> Result wrn ()
222checkPatternsHelp tagDict region origin unhandled patterns =
222checkPatternsHelp tagDict region origin unhandled patterns =
223− case (unhandled, patterns) of
223+ case patterns of
224− ([], []) ->
224+ [] ->
225+ if Set.size unhandled == 0 then
225− return ()
226+ return ()
226−
227+ else
227− (_:_, []) ->
228− Result.throw region (Error.Incomplete origin unhandled)
228+ Result.throw region (Error.Incomplete origin unhandled)
229
229
230− (_, pattern@(A.A localRegion _) : remainingPatterns) ->
230+ pattern@(A.A localRegion _) : remainingPatterns ->
231 do newUnhandled <- filterPatterns tagDict localRegion pattern unhandled
231 do newUnhandled <- filterPatterns tagDict localRegion pattern unhandled
232 checkPatternsHelp tagDict region origin newUnhandled remainingPatterns
232 checkPatternsHelp tagDict region origin newUnhandled remainingPatterns
233
233
@@ -236,8 +236,8 @@ filterPatterns
236 :: TagDict
236 :: TagDict
237 -> Region.Region
237 -> Region.Region
238 -> Pattern.Canonical
238 -> Pattern.Canonical
239− -> [Pattern]
239+ -> Set.Set Pattern
240− -> Result wrn [Pattern]
240+ -> Result wrn (Set.Set Pattern)
241filterPatterns tagDict region pattern unhandled =
241filterPatterns tagDict region pattern unhandled =
242 let
242 let
243 nitPattern =
243 nitPattern =
@@ -252,6 +252,7 @@ filterPatterns tagDict region pattern unhandled =
252 else
252 else
253 do let complementPatterns = complement tagDict nitPattern
253 do let complementPatterns = complement tagDict nitPattern
254 return $
254 return $
255+ Set.fromList $
255 concatMap
256 concatMap
256 (\p -> Maybe.mapMaybe (intersection p) complementPatterns)
257 (\p -> Maybe.mapMaybe (intersection p) complementPatterns)
257 unhandled
258 unhandled
src/Reporting/Error/Pattern.hs+4−3
@@ -1,6 +1,7 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Pattern where
2module Reporting.Error.Pattern where
3
3
4+import qualified Data.Set as Set
4import Text.PrettyPrint.ANSI.Leijen (text)
5import Text.PrettyPrint.ANSI.Leijen (text)
5
6
6import qualified Nitpick.Pattern as Pattern
7import qualified Nitpick.Pattern as Pattern
@@ -11,7 +12,7 @@ import qualified Reporting.Report as Report
11
12
12
13
13data Error
14data Error
14− = Incomplete Origin [Pattern.Pattern]
15+ = Incomplete Origin (Set.Set Pattern.Pattern)
15 | Redundant
16 | Redundant
16
17
17
18
@@ -57,11 +58,11 @@ toReport _localizer err =
57 (text "Any value with this shape will be handled by a previous pattern.")
58 (text "Any value with this shape will be handled by a previous pattern.")
58
59
59
60
60−unhandledError :: [Pattern.Pattern] -> String -> String
61+unhandledError :: Set.Set Pattern.Pattern -> String -> String
61unhandledError unhandledPatterns relevantMessage =
62unhandledError unhandledPatterns relevantMessage =
62 let
63 let
63 (visiblePatterns, rest) =
64 (visiblePatterns, rest) =
64− splitAt 4 unhandledPatterns
65+ splitAt 4 (Set.toList unhandledPatterns)
65
66
66 patternList =
67 patternList =
67 map (Pattern.toString False) visiblePatterns
68 map (Pattern.toString False) visiblePatterns