Commit 7005b9f7 authored by quchen's avatar quchen Committed by Ben Gamari
Browse files

Add flag to control number of missing patterns in warnings

Non-exhaustive pattern warnings had their number of patterns to
show hardcoded in the past. This patch implements the TODO remark
that this should be made a command line flag.

    -fmax-uncovered-patterns=<n>

can now be used to influence the number of patterns to be shown.

Reviewers: hvr, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2076
parent 07dc3307
...@@ -1256,6 +1256,8 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result ...@@ -1256,6 +1256,8 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result
flag_u = exhaustive dflags kind flag_u = exhaustive dflags kind
flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind) flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind)
maxPatterns = maxUncoveredPatterns dflags
-- Print a single clause (for redundant/with-inaccessible-rhs) -- Print a single clause (for redundant/with-inaccessible-rhs)
pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q pprEqn q txt = pp_context True ctx (text txt) $ \f -> ppr_eqn f kind q
...@@ -1266,7 +1268,8 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result ...@@ -1266,7 +1268,8 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result
-> text "Guards do not cover entire pattern space" -> text "Guards do not cover entire pattern space"
_missing -> let us = map ppr qs _missing -> let us = map ppr qs
in hang (text "Patterns not matched:") 4 in hang (text "Patterns not matched:") 4
(vcat (take maximum_output us) $$ dots us) (vcat (take maxPatterns us)
$$ dots maxPatterns us)
-- | Issue a warning when the predefined number of iterations is exceeded -- | Issue a warning when the predefined number of iterations is exceeded
-- for the pattern match checker -- for the pattern match checker
...@@ -1285,9 +1288,10 @@ warnPmIters dflags (DsMatchContext kind loc) ...@@ -1285,9 +1288,10 @@ warnPmIters dflags (DsMatchContext kind loc)
flag_i = wopt Opt_WarnOverlappingPatterns dflags flag_i = wopt Opt_WarnOverlappingPatterns dflags
flag_u = exhaustive dflags kind flag_u = exhaustive dflags kind
dots :: [a] -> SDoc dots :: Int -> [a] -> SDoc
dots qs | qs `lengthExceeds` maximum_output = text "..." dots maxPatterns qs
| otherwise = empty | qs `lengthExceeds` maxPatterns = text "..."
| otherwise = empty
-- | Check whether the exhaustiveness checker should run (exhaustiveness only) -- | Check whether the exhaustiveness checker should run (exhaustiveness only)
exhaustive :: DynFlags -> HsMatchContext id -> Bool exhaustive :: DynFlags -> HsMatchContext id -> Bool
...@@ -1347,12 +1351,6 @@ ppr_uncovered (expr_vec, complex) ...@@ -1347,12 +1351,6 @@ ppr_uncovered (expr_vec, complex)
sdoc_vec = mapM pprPmExprWithParens expr_vec sdoc_vec = mapM pprPmExprWithParens expr_vec
(vec,cs) = runPmPprM sdoc_vec (filterComplex complex) (vec,cs) = runPmPprM sdoc_vec (filterComplex complex)
-- | This variable shows the maximum number of lines of output generated for
-- warnings. It will limit the number of patterns/equations displayed to
-- maximum_output. (TODO: add command-line option?)
maximum_output :: Int
maximum_output = 4
{- Note [Representation of Term Equalities] {- Note [Representation of Term Equalities]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In the paper, term constraints always take the form (x ~ e). Of course, a more In the paper, term constraints always take the form (x ~ e). Of course, a more
......
...@@ -664,6 +664,8 @@ data DynFlags = DynFlags { ...@@ -664,6 +664,8 @@ data DynFlags = DynFlags {
maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt maxRelevantBinds :: Maybe Int, -- ^ Maximum number of bindings from the type envt
-- to show in type error messages -- to show in type error messages
maxUncoveredPatterns :: Int, -- ^ Maximum number of unmatched patterns to show
-- in non-exhaustiveness warnings
simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks simplTickFactor :: Int, -- ^ Multiplier for simplifier ticks
specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr
specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function
...@@ -1448,6 +1450,7 @@ defaultDynFlags mySettings = ...@@ -1448,6 +1450,7 @@ defaultDynFlags mySettings =
maxPmCheckIterations = 2000000, maxPmCheckIterations = 2000000,
ruleCheck = Nothing, ruleCheck = Nothing,
maxRelevantBinds = Just 6, maxRelevantBinds = Just 6,
maxUncoveredPatterns = 4,
simplTickFactor = 100, simplTickFactor = 100,
specConstrThreshold = Just 2000, specConstrThreshold = Just 2000,
specConstrCount = Just 3, specConstrCount = Just 3,
...@@ -2837,6 +2840,8 @@ dynamic_flags_deps = [ ...@@ -2837,6 +2840,8 @@ dynamic_flags_deps = [
(intSuffix (\n d -> d { maxRelevantBinds = Just n })) (intSuffix (\n d -> d { maxRelevantBinds = Just n }))
, make_ord_flag defFlag "fno-max-relevant-binds" , make_ord_flag defFlag "fno-max-relevant-binds"
(noArg (\d -> d { maxRelevantBinds = Nothing })) (noArg (\d -> d { maxRelevantBinds = Nothing }))
, make_ord_flag defFlag "fmax-uncovered-patterns"
(intSuffix (\n d -> d { maxUncoveredPatterns = n }))
, make_ord_flag defFlag "fsimplifier-phases" , make_ord_flag defFlag "fsimplifier-phases"
(intSuffix (\n d -> d { simplPhases = n })) (intSuffix (\n d -> d { simplPhases = n }))
, make_ord_flag defFlag "fmax-simplifier-iterations" , make_ord_flag defFlag "fmax-simplifier-iterations"
......
...@@ -120,7 +120,7 @@ list. ...@@ -120,7 +120,7 @@ list.
case x of case x of
Red -> e1 Red -> e1
_ -> case x of _ -> case x of
Blue -> e2 Blue -> e2
Green -> e3 Green -> e3
...@@ -353,6 +353,13 @@ list. ...@@ -353,6 +353,13 @@ list.
they may be numerous), but ``-fno-max-relevant-bindings`` includes they may be numerous), but ``-fno-max-relevant-bindings`` includes
them too. them too.
.. ghc-flag:: -fmax-uncovered-patterns=<n>
:default: 4
Maximum number of unmatched patterns to be shown in warnings generated by
:ghc-flag:`-Wincomplete-patterns` and :ghc-flag:`-Wincomplete-uni-patterns`.
.. ghc-flag:: -fmax-simplifier-iterations=<n> .. ghc-flag:: -fmax-simplifier-iterations=<n>
:default: 4 :default: 4
......
...@@ -178,6 +178,12 @@ optimizationsOptions = ...@@ -178,6 +178,12 @@ optimizationsOptions =
, flagType = DynamicFlag , flagType = DynamicFlag
, flagReverse = "-fno-max-relevant-bindings" , flagReverse = "-fno-max-relevant-bindings"
} }
, flag { flagName = "-fmax-uncovered-patterns=⟨n⟩"
, flagDescription =
"*default: 4.* Set the maximum number of patterns to display in "++
"warnings about non-exhaustive ones."
, flagType = DynamicFlag
}
, flag { flagName = "-fmax-simplifier-iterations=⟨n⟩" , flag { flagName = "-fmax-simplifier-iterations=⟨n⟩"
, flagDescription = , flagDescription =
"*default: 4.* Set the max iterations for the simplifier." "*default: 4.* Set the max iterations for the simplifier."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment