git.iko.soy/elk
on master help sign in
Merge pull request #1470 from brianhempel/faster_builds

Speed up exhaustiveness checker

commit96a4695e4d311e0addd1619db63062c445a55f4b authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 24 Aug 2016, 11:22 (10 years ago) parentee39e7ea3ef05f
3 files changed+17−15
compare with master
unifiedsplit
src/Nitpick/Pattern.hs+1−1 src/Nitpick/PatternMatches.hs+12−11 src/Reporting/Error/Pattern.hs+4−3
src/Nitpick/Pattern.hs+1−1
@@ -17,7 +17,7 @@ data Pattern
1717 | Anything
1818 | Literal L.Literal
1919 | AnythingBut (Set.Set L.Literal)
20− deriving (Eq)
20+ deriving (Eq, Ord)
2121
2222
2323fromCanonicalPattern :: P.Canonical -> Pattern
src/Nitpick/PatternMatches.hs+12−11
@@ -209,25 +209,25 @@ checkExpression tagDict (A.A region expression) =
209209
210210checkPatterns :: TagDict -> Region.Region -> Error.Origin -> [Pattern.Canonical] -> Result wrn ()
211211checkPatterns tagDict region origin patterns =
212− checkPatternsHelp tagDict region origin [Anything] patterns
212+ checkPatternsHelp tagDict region origin (Set.singleton Anything) patterns
213213
214214
215215checkPatternsHelp
216216 :: TagDict
217217 -> Region.Region
218218 -> Error.Origin
219− -> [Pattern]
219+ -> Set.Set Pattern
220220 -> [Pattern.Canonical]
221221 -> Result wrn ()
222222checkPatternsHelp tagDict region origin unhandled patterns =
223− case (unhandled, patterns) of
224− ([], []) ->
225− return ()
226−
227− (_:_, []) ->
228− Result.throw region (Error.Incomplete origin unhandled)
223+ case patterns of
224+ [] ->
225+ if Set.size unhandled == 0 then
226+ return ()
227+ else
228+ Result.throw region (Error.Incomplete origin unhandled)
229229
230− (_, pattern@(A.A localRegion _) : remainingPatterns) ->
230+ pattern@(A.A localRegion _) : remainingPatterns ->
231231 do newUnhandled <- filterPatterns tagDict localRegion pattern unhandled
232232 checkPatternsHelp tagDict region origin newUnhandled remainingPatterns
233233
@@ -236,8 +236,8 @@ filterPatterns
236236 :: TagDict
237237 -> Region.Region
238238 -> Pattern.Canonical
239− -> [Pattern]
240− -> Result wrn [Pattern]
239+ -> Set.Set Pattern
240+ -> Result wrn (Set.Set Pattern)
241241filterPatterns tagDict region pattern unhandled =
242242 let
243243 nitPattern =
@@ -252,6 +252,7 @@ filterPatterns tagDict region pattern unhandled =
252252 else
253253 do let complementPatterns = complement tagDict nitPattern
254254 return $
255+ Set.fromList $
255256 concatMap
256257 (\p -> Maybe.mapMaybe (intersection p) complementPatterns)
257258 unhandled
src/Reporting/Error/Pattern.hs+4−3
@@ -1,6 +1,7 @@
11{-# OPTIONS_GHC -Wall #-}
22module Reporting.Error.Pattern where
33
4+import qualified Data.Set as Set
45import Text.PrettyPrint.ANSI.Leijen (text)
56
67import qualified Nitpick.Pattern as Pattern
@@ -11,7 +12,7 @@ import qualified Reporting.Report as Report
1112
1213
1314data Error
14− = Incomplete Origin [Pattern.Pattern]
15+ = Incomplete Origin (Set.Set Pattern.Pattern)
1516 | Redundant
1617
1718
@@ -57,11 +58,11 @@ toReport _localizer err =
5758 (text "Any value with this shape will be handled by a previous pattern.")
5859
5960
60−unhandledError :: [Pattern.Pattern] -> String -> String
61+unhandledError :: Set.Set Pattern.Pattern -> String -> String
6162unhandledError unhandledPatterns relevantMessage =
6263 let
6364 (visiblePatterns, rest) =
64− splitAt 4 unhandledPatterns
65+ splitAt 4 (Set.toList unhandledPatterns)
6566
6667 patternList =
6768 map (Pattern.toString False) visiblePatterns