diff options
| author | Herbert Valerio Riedel <hvr@gnu.org> | 2016-02-27 13:50:10 +0100 |
|---|---|---|
| committer | Herbert Valerio Riedel <hvr@gnu.org> | 2016-02-27 16:35:45 +0100 |
| commit | b9c697eefd34fcba3ab9c1f831baf7f651ad7503 (patch) | |
| tree | 73dd59a223adc3f855da6613c0a99ed2e1fb6f77 /compiler/deSugar/Desugar.hs | |
| parent | 3ee4fc04322dacb66c70262a220dce0f52c29d4f (diff) | |
| download | haskell-b9c697eefd34fcba3ab9c1f831baf7f651ad7503.tar.gz | |
Print which flag controls emitted desugaring warnings
This is extends bb5afd3c274011c5ea302210b4c290ec1f83209c to cover
warnings emitted during the desugaring phase.
This implements another part of #10752
Reviewed-by: quchen, bgamari
Differential Revision: https://phabricator.haskell.org/D1954
Diffstat (limited to 'compiler/deSugar/Desugar.hs')
| -rw-r--r-- | compiler/deSugar/Desugar.hs | 8 |
1 files changed, 5 insertions, 3 deletions
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs index 1c175f2cbd..6f14b63b93 100644 --- a/compiler/deSugar/Desugar.hs +++ b/compiler/deSugar/Desugar.hs @@ -563,7 +563,7 @@ dsRule (L loc (HsRule name rule_act vars lhs _tv_lhs rhs _fv_rhs)) -- Substitute the dict bindings eagerly, -- and take the body apart into a (f args) form ; case decomposeRuleLhs bndrs'' lhs'' of { - Left msg -> do { warnDs msg; return Nothing } ; + Left msg -> do { warnDs NoReason msg; return Nothing } ; Right (final_bndrs, fn_id, args) -> do { let is_local = isLocalId fn_id @@ -598,7 +598,8 @@ warnRuleShadowing rule_name rule_act fn_id arg_ids | isLocalId lhs_id || canUnfold (idUnfolding lhs_id) -- If imported with no unfolding, no worries , idInlineActivation lhs_id `competesWith` rule_act - = warnDs (vcat [ hang (text "Rule" <+> pprRuleName rule_name + = warnDs (Reason Opt_WarnInlineRuleShadowing) + (vcat [ hang (text "Rule" <+> pprRuleName rule_name <+> text "may never fire") 2 (text "because" <+> quotes (ppr lhs_id) <+> text "might inline first") @@ -608,7 +609,8 @@ warnRuleShadowing rule_name rule_act fn_id arg_ids | check_rules_too , bad_rule : _ <- get_bad_rules lhs_id - = warnDs (vcat [ hang (text "Rule" <+> pprRuleName rule_name + = warnDs (Reason Opt_WarnInlineRuleShadowing) + (vcat [ hang (text "Rule" <+> pprRuleName rule_name <+> text "may never fire") 2 (text "because rule" <+> pprRuleName (ruleName bad_rule) <+> text "for"<+> quotes (ppr lhs_id) |