diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-02-08 16:12:36 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-02-08 16:18:14 +0000 |
| commit | 3cfef763ab6ccd23f72604e5ee2f027a4b6ce043 (patch) | |
| tree | efc865f693cad0c11bdf45df0cc1a9b556022a24 /compiler/deSugar/Check.hs | |
| parent | 9f3c1e67e5731124e499a420df52397b652876c8 (diff) | |
| download | haskell-3cfef763ab6ccd23f72604e5ee2f027a4b6ce043.tar.gz | |
Kill inaccessible-branch complaints in record update
Trac #12957 (the original case in the Description) showed a record
update that yielded an "inaccessible code" warning. This should not
happen; it's just some redundant code generated by the desugarer (later
pruned away) and it's not the user's fault.
This patch suppresses the warning. See Check.hs
Note [Inaccessible warnings for record updates]
Diffstat (limited to 'compiler/deSugar/Check.hs')
| -rw-r--r-- | compiler/deSugar/Check.hs | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs index 3bf52ceaa0..4a8a18d77c 100644 --- a/compiler/deSugar/Check.hs +++ b/compiler/deSugar/Check.hs @@ -51,7 +51,6 @@ import Control.Monad (forM, when, forM_) import Coercion import TcEvidence import IOEnv -import Data.Monoid ( Monoid(mappend) ) import ListT (ListT(..), fold, select) @@ -1606,7 +1605,7 @@ dsPmWarn :: DynFlags -> DsMatchContext -> PmResult -> DsM () dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result = when (flag_i || flag_u) $ do let exists_r = flag_i && notNull redundant && onlyBuiltin - exists_i = flag_i && notNull inaccessible && onlyBuiltin + exists_i = flag_i && notNull inaccessible && onlyBuiltin && not is_rec_upd exists_u = flag_u && (case uncovered of TypeOfUncovered _ -> True UncoveredPatterns u -> notNull u) @@ -1632,6 +1631,9 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result flag_u = exhaustive dflags kind flag_u_reason = maybe NoReason Reason (exhaustiveWarningFlag kind) + is_rec_upd = case kind of { RecUpd -> True; _ -> False } + -- See Note [Inaccessible warnings for record updates] + onlyBuiltin = prov == FromBuiltin maxPatterns = maxUncoveredPatterns dflags @@ -1654,6 +1656,28 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) pm_result warnEmptyCase ty = pp_context False ctx (text "are non-exhaustive") $ \_ -> hang (text "Patterns not matched:") 4 (underscore <+> dcolon <+> ppr ty) +{- Note [Inaccessible warnings for record updates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (Trac #12957) + data T a where + T1 :: { x :: Int } -> T Bool + T2 :: { x :: Int } -> T a + T3 :: T a + + f :: T Char -> T a + f r = r { x = 3 } + +The desugarer will (conservatively generate a case for T1 even though +it's impossible: + f r = case r of + T1 x -> T1 3 -- Inaccessible branch + T2 x -> T2 3 + _ -> error "Missing" + +We don't want to warn about the inaccessible branch because the programmer +didn't put it there! So we filter out the warning here. +-} + -- | Issue a warning when the predefined number of iterations is exceeded -- for the pattern match checker warnPmIters :: DynFlags -> DsMatchContext -> DsM () |
