Warn on all out-of-range literals in pats/exprs

Summary:
These changes were motivated by #13256. While poking around, I
realized we weren't very consistent in our "-Woverflowed-literals"
warnings. This patch fixes that by:

  * warning earlier on in the pipeline (ie. before we've desugared
    'Int' patterns into 'I# Int#')
  * handling 'HsLit' as well as 'HsOverLit' (this covers unboxed
    literals)
  * covering more pattern / expression forms

4/6 of the warnings in the 'Overflow' test are due to this patch. The
other two are mostly for completeness.

Also fixed a missing empty-enumeration warning for 'Natural'.

This warnings were tripped up by the 'Bounded Word' instance (see #9505),
but the fix was obvious and simple: use unboxed word literals.

Test Plan: make TEST=Overflow && make TEST=T10930

Reviewers: hvr, bgamari, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, carter

GHC Trac Issues: #13256, #10930

Differential Revision: https://phabricator.haskell.org/D5181

6 files changed, 189 insertions, 96 deletions

diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 08822df60b..7306352674 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -213,6 +213,7 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss
        ; checkGuardMatches PatBindGuards grhss
        ; let upat = unLoc pat
              eqn = EqnInfo { eqn_pats = [upat],
+                             eqn_orig = FromSource,
                              eqn_rhs = cantFailMatchResult body }
        ; var    <- selectMatchVar upat
        ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
@@ -264,8 +265,14 @@ ds_expr _ (HsUnboundVar {})      = panic "dsExpr: HsUnboundVar" -- Typechecker e
 ds_expr w (HsConLikeOut _ con)   = dsConLike w con
 ds_expr _ (HsIPVar {})           = panic "dsExpr: HsIPVar"
 ds_expr _ (HsOverLabel{})        = panic "dsExpr: HsOverLabel"
-ds_expr _ (HsLit _ lit)          = dsLit (convertLit lit)
-ds_expr _ (HsOverLit _ lit)      = dsOverLit lit
+
+ds_expr _ (HsLit _ lit)
+  = do { warnAboutOverflowedLit lit
+       ; dsLit (convertLit lit) }
+
+ds_expr _ (HsOverLit _ lit)
+  = do { warnAboutOverflowedOverLit lit
+       ; dsOverLit lit }
 
 ds_expr _ (HsWrap _ co_fn e)
   = do { e' <- ds_expr True e    -- This is the one place where we recurse to
@@ -282,10 +289,9 @@ ds_expr _ (NegApp _ (dL->L loc
                       (HsOverLit _ lit@(OverLit { ol_val = HsIntegral i})))
                   neg_expr)
   = do { expr' <- putSrcSpanDs loc $ do
-          { dflags <- getDynFlags
-          ; warnAboutOverflowedLiterals dflags
-                                        (lit { ol_val = HsIntegral (negateIntegralLit i) })
-          ; dsOverLit' dflags lit }
+          { warnAboutOverflowedOverLit
+              (lit { ol_val = HsIntegral (negateIntegralLit i) })
+          ; dsOverLit lit }
        ; dsSyntaxExpr neg_expr [expr'] }
 
 ds_expr _ (NegApp _ expr neg_expr)
diff --git a/compiler/deSugar/DsMonad.hs b/compiler/deSugar/DsMonad.hs
index 5d597912e5..7742f8cd76 100644
--- a/compiler/deSugar/DsMonad.hs
+++ b/compiler/deSugar/DsMonad.hs
@@ -66,6 +66,7 @@ import PrelNames
 import RdrName
 import HscTypes
 import Bag
+import BasicTypes ( Origin )
 import DataCon
 import ConLike
 import TyCon
@@ -104,14 +105,27 @@ instance Outputable DsMatchContext where
   ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match
 
 data EquationInfo
-  = EqnInfo { eqn_pats :: [Pat GhcTc],  -- The patterns for an eqn
-                -- NB: We have /already/ applied decideBangHood to
-                -- these patterns.  See Note [decideBangHood] in DsUtils
-
-              eqn_rhs  :: MatchResult } -- What to do after match
+  = EqnInfo { eqn_pats :: [Pat GhcTc]
+              -- ^ The patterns for an equation
+              --
+              -- NB: We have /already/ applied 'decideBangHood' to
+              -- these patterns.  See Note [decideBangHood] in "DsUtils"
+
+            , eqn_orig :: Origin
+              -- ^ Was this equation present in the user source?
+              --
+              -- This helps us avoid warnings on patterns that GHC elaborated.
+              --
+              -- For instance, the pattern @-1 :: Word@ gets desugared into
+              -- @W# -1## :: Word@, but we shouldn't warn about an overflowed
+              -- literal for /both/ of these cases.
+
+            , eqn_rhs  :: MatchResult
+              -- ^ What to do after match
+            }
 
 instance Outputable EquationInfo where
-    ppr (EqnInfo pats _) = ppr pats
+    ppr (EqnInfo pats _ _) = ppr pats
 
 type DsWrapper = CoreExpr -> CoreExpr
 idDsWrapper :: DsWrapper
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index 11fcbf20b6..0930a6e6f4 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -19,6 +19,7 @@ import GhcPrelude
 
 import {-#SOURCE#-} DsExpr (dsLExpr, dsSyntaxExpr)
 
+import BasicTypes ( Origin(..) )
 import DynFlags
 import HsSyn
 import TcHsSyn
@@ -160,11 +161,11 @@ See also Note [Localise pattern binders] in DsUtils
 
 type MatchId = Id   -- See Note [Match Ids]
 
-match :: [MatchId]        -- Variables rep\'ing the exprs we\'re matching with
-                          -- See Note [Match Ids]
-      -> Type             -- Type of the case expression
-      -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
-      -> DsM MatchResult  -- Desugared result!
+match :: [MatchId]        -- ^ Variables rep\'ing the exprs we\'re matching with
+                          -- ^ See Note [Match Ids]
+      -> Type             -- ^ Type of the case expression
+      -> [EquationInfo]   -- ^ Info about patterns, etc. (type synonym below)
+      -> DsM MatchResult  -- ^ Desugared result!
 
 match [] ty eqns
   = ASSERT2( not (null eqns), ppr ty )
@@ -387,11 +388,12 @@ tidyEqnInfo :: Id -> EquationInfo
 tidyEqnInfo _ (EqnInfo { eqn_pats = [] })
   = panic "tidyEqnInfo"
 
-tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats })
-  = do { (wrap, pat') <- tidy1 v pat
+tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig })
+  = do { (wrap, pat') <- tidy1 v orig pat
        ; return (wrap, eqn { eqn_pats = do pat' : pats }) }
 
 tidy1 :: Id                  -- The Id being scrutinised
+      -> Origin              -- Was this a pattern the user wrote?
       -> Pat GhcTc           -- The pattern against which it is to be matched
       -> DsM (DsWrapper,     -- Extra bindings to do before the match
               Pat GhcTc)     -- Equivalent pattern
@@ -402,20 +404,20 @@ tidy1 :: Id                  -- The Id being scrutinised
 -- It eliminates many pattern forms (as-patterns, variable patterns,
 -- list patterns, etc) and returns any created bindings in the wrapper.
 
-tidy1 v (ParPat _ pat)          = tidy1 v (unLoc pat)
-tidy1 v (SigPat _ pat _)        = tidy1 v (unLoc pat)
-tidy1 _ (WildPat ty)            = return (idDsWrapper, WildPat ty)
-tidy1 v (BangPat _ (dL->L l p)) = tidy_bang_pat v l p
+tidy1 v o (ParPat _ pat)      = tidy1 v o (unLoc pat)
+tidy1 v o (SigPat _ pat _)    = tidy1 v o (unLoc pat)
+tidy1 _ _ (WildPat ty)        = return (idDsWrapper, WildPat ty)
+tidy1 v o (BangPat _ (dL->L l p)) = tidy_bang_pat v o l p
 
         -- case v of { x -> mr[] }
         -- = case v of { _ -> let x=v in mr[] }
-tidy1 v (VarPat _ (dL->L _ var))
+tidy1 v _ (VarPat _ (dL->L _ var))
   = return (wrapBind var v, WildPat (idType var))
 
         -- case v of { x@p -> mr[] }
         -- = case v of { p -> let x=v in mr[] }
-tidy1 v (AsPat _ (dL->L _ var) pat)
-  = do  { (wrap, pat') <- tidy1 v (unLoc pat)
+tidy1 v o (AsPat _ (dL->L _ var) pat)
+  = do  { (wrap, pat') <- tidy1 v o (unLoc pat)
         ; return (wrapBind var v . wrap, pat') }
 
 {- now, here we handle lazy patterns:
@@ -429,7 +431,7 @@ tidy1 v (AsPat _ (dL->L _ var) pat)
     The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
 -}
 
-tidy1 v (LazyPat _ pat)
+tidy1 v _ (LazyPat _ pat)
     -- This is a convenient place to check for unlifted types under a lazy pattern.
     -- Doing this check during type-checking is unsatisfactory because we may
     -- not fully know the zonked types yet. We sure do here.
@@ -445,65 +447,79 @@ tidy1 v (LazyPat _ pat)
         ; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
         ; return (mkCoreLets sel_binds, WildPat (idType v)) }
 
-tidy1 _ (ListPat (ListPatTc ty Nothing) pats )
+tidy1 _ _ (ListPat (ListPatTc ty Nothing) pats )
   = return (idDsWrapper, unLoc list_ConPat)
   where
     list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] [ty])
                         (mkNilPat ty)
                         pats
 
-tidy1 _ (TuplePat tys pats boxity)
+tidy1 _ _ (TuplePat tys pats boxity)
   = return (idDsWrapper, unLoc tuple_ConPat)
   where
     arity = length pats
     tuple_ConPat = mkPrefixConPat (tupleDataCon boxity arity) pats tys
 
-tidy1 _ (SumPat tys pat alt arity)
+tidy1 _ _ (SumPat tys pat alt arity)
   = return (idDsWrapper, unLoc sum_ConPat)
   where
     sum_ConPat = mkPrefixConPat (sumDataCon alt arity) [pat] tys
 
 -- LitPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (LitPat _ lit)
-  = return (idDsWrapper, tidyLitPat lit)
+tidy1 _ o (LitPat _ lit)
+  = do { unless (isGenerated o) $
+           warnAboutOverflowedLit lit
+       ; return (idDsWrapper, tidyLitPat lit) }
 
 -- NPats: we *might* be able to replace these w/ a simpler form
-tidy1 _ (NPat ty (dL->L _ lit) mb_neg eq)
-  = return (idDsWrapper, tidyNPat lit mb_neg eq ty)
+tidy1 _ o (NPat ty (dL->L _ lit@OverLit { ol_val = v }) mb_neg eq)
+  = do { unless (isGenerated o) $
+           let lit' | Just _ <- mb_neg = lit{ ol_val = negateOverLitVal v }
+                    | otherwise = lit
+           in warnAboutOverflowedOverLit lit'
+       ; return (idDsWrapper, tidyNPat lit mb_neg eq ty) }
+
+-- NPlusKPat: we may want to warn about the literals
+tidy1 _ o n@(NPlusKPat _ _ (dL->L _ lit1) lit2 _ _)
+  = do { unless (isGenerated o) $ do
+           warnAboutOverflowedOverLit lit1
+           warnAboutOverflowedOverLit lit2
+       ; return (idDsWrapper, n) }
 
 -- Everything else goes through unchanged...
-
-tidy1 _ non_interesting_pat
+tidy1 _ _ non_interesting_pat
   = return (idDsWrapper, non_interesting_pat)
 
 --------------------
-tidy_bang_pat :: Id -> SrcSpan -> Pat GhcTc -> DsM (DsWrapper, Pat GhcTc)
+tidy_bang_pat :: Id -> Origin -> SrcSpan -> Pat GhcTc
+              -> DsM (DsWrapper, Pat GhcTc)
 
 -- Discard par/sig under a bang
-tidy_bang_pat v _ (ParPat _ (dL->L l p)) = tidy_bang_pat v l p
-tidy_bang_pat v _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v l p
+tidy_bang_pat v o _ (ParPat _ (dL->L l p)) = tidy_bang_pat v o l p
+tidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p
 
 -- Push the bang-pattern inwards, in the hope that
 -- it may disappear next time
-tidy_bang_pat v l (AsPat x v' p) = tidy1 v (AsPat x v' (cL l (BangPat noExt p)))
-tidy_bang_pat v l (CoPat x w p t)
-  = tidy1 v (CoPat x w (BangPat noExt (cL l p)) t)
+tidy_bang_pat v o l (AsPat x v' p)
+  = tidy1 v o (AsPat x v' (cL l (BangPat noExt p)))
+tidy_bang_pat v o l (CoPat x w p t)
+  = tidy1 v o (CoPat x w (BangPat noExt (cL l p)) t)
 
 -- Discard bang around strict pattern
-tidy_bang_pat v _ p@(LitPat {})    = tidy1 v p
-tidy_bang_pat v _ p@(ListPat {})   = tidy1 v p
-tidy_bang_pat v _ p@(TuplePat {})  = tidy1 v p
-tidy_bang_pat v _ p@(SumPat {})    = tidy1 v p
+tidy_bang_pat v o _ p@(LitPat {})    = tidy1 v o p
+tidy_bang_pat v o _ p@(ListPat {})   = tidy1 v o p
+tidy_bang_pat v o _ p@(TuplePat {})  = tidy1 v o p
+tidy_bang_pat v o _ p@(SumPat {})    = tidy1 v o p
 
 -- Data/newtype constructors
-tidy_bang_pat v l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
-                               , pat_args = args
-                               , pat_arg_tys = arg_tys })
+tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
+                                 , pat_args = args
+                                 , pat_arg_tys = arg_tys })
   -- Newtypes: push bang inwards (Trac #9844)
   =
     if isNewTyCon (dataConTyCon dc)
-      then tidy1 v (p { pat_args = push_bang_into_newtype_arg l ty args })
-      else tidy1 v p  -- Data types: discard the bang
+      then tidy1 v o (p { pat_args = push_bang_into_newtype_arg l ty args })
+      else tidy1 v o p  -- Data types: discard the bang
     where
       (ty:_) = dataConInstArgTys dc arg_tys
 
@@ -522,7 +538,7 @@ tidy_bang_pat v l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
 --
 -- NB: SigPatIn, ConPatIn should not happen
 
-tidy_bang_pat _ l p = return (idDsWrapper, BangPat noExt (cL l p))
+tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExt (cL l p))
 
 -------------------
 push_bang_into_newtype_arg :: SrcSpan
@@ -672,10 +688,11 @@ Call @match@ with all of this information!
 \end{enumerate}
 -}
 
-matchWrapper :: HsMatchContext Name    -- For shadowing warning messages
-             -> Maybe (LHsExpr GhcTc)  -- The scrutinee, if we check a case expr
-             -> MatchGroup GhcTc (LHsExpr GhcTc)   -- Matches being desugared
-             -> DsM ([Id], CoreExpr)   -- Results
+matchWrapper
+  :: HsMatchContext Name               -- ^ For shadowing warning messages
+  -> Maybe (LHsExpr GhcTc)             -- ^ Scrutinee, if we check a case expr
+  -> MatchGroup GhcTc (LHsExpr GhcTc)  -- ^ Matches being desugared
+  -> DsM ([Id], CoreExpr)              -- ^ Results (usually passed to 'match')
 
 {-
  There is one small problem with the Lambda Patterns, when somebody
@@ -732,7 +749,9 @@ matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)
            ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]
                              addTmCsDs tm_cs  $ -- See Note [Type and Term Equality Propagation]
                              dsGRHSs ctxt grhss rhs_ty
-           ; return (EqnInfo { eqn_pats = upats, eqn_rhs = match_result}) }
+           ; return (EqnInfo { eqn_pats = upats
+                             , eqn_orig = FromSource
+                             , eqn_rhs = match_result }) }
     mk_eqn_info _ (dL->L _ (XMatch _)) = panic "matchWrapper"
     mk_eqn_info _ _  = panic "mk_eqn_info: Impossible Match" -- due to #15884
 
@@ -764,11 +783,11 @@ situation where we want to match a single expression against a single
 pattern. It returns an expression.
 -}
 
-matchSimply :: CoreExpr                 -- Scrutinee
-            -> HsMatchContext Name      -- Match kind
-            -> LPat GhcTc               -- Pattern it should match
-            -> CoreExpr                 -- Return this if it matches
-            -> CoreExpr                 -- Return this if it doesn't
+matchSimply :: CoreExpr                 -- ^ Scrutinee
+            -> HsMatchContext Name      -- ^ Match kind
+            -> LPat GhcTc               -- ^ Pattern it should match
+            -> CoreExpr                 -- ^ Return this if it matches
+            -> CoreExpr                 -- ^ Return this if it doesn't
             -> DsM CoreExpr
 -- Do not warn about incomplete patterns; see matchSinglePat comments
 matchSimply scrut hs_ctx pat result_expr fail_expr = do
@@ -809,6 +828,7 @@ matchSinglePatVar var ctx pat ty match_result
        ; checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat)
 
        ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)]
+                                , eqn_orig = FromSource
                                 , eqn_rhs  = match_result }
        ; match [var] ty [eqn_info] }
 
diff --git a/compiler/deSugar/MatchCon.hs b/compiler/deSugar/MatchCon.hs
index ddb8000442..f699792910 100644
--- a/compiler/deSugar/MatchCon.hs
+++ b/compiler/deSugar/MatchCon.hs
@@ -21,6 +21,7 @@ import {-# SOURCE #-} Match     ( match )
 import HsSyn
 import DsBinds
 import ConLike
+import BasicTypes ( Origin(..) )
 import TcType
 import DsMonad
 import DsUtils
@@ -148,7 +149,8 @@ matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
                      return ( wrapBinds (tvs `zip` tvs1)
                             . wrapBinds (ds  `zip` dicts1)
                             . mkCoreLets ds_bind
-                            , eqn { eqn_pats = conArgPats val_arg_tys args ++ pats }
+                            , eqn { eqn_orig = Generated
+                                  , eqn_pats = conArgPats val_arg_tys args ++ pats }
                             )
               shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps)
 
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index 94ffe81781..824dce138b 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -9,10 +9,11 @@ Pattern-matching literal patterns
 {-# LANGUAGE CPP, ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module MatchLit ( dsLit, dsOverLit, dsOverLit', hsLitKey
+module MatchLit ( dsLit, dsOverLit, hsLitKey
                 , tidyLitPat, tidyNPat
                 , matchLiterals, matchNPlusKPats, matchNPats
-                , warnAboutIdentities, warnAboutOverflowedLiterals
+                , warnAboutIdentities
+                , warnAboutOverflowedOverLit, warnAboutOverflowedLit
                 , warnAboutEmptyEnumerations
                 ) where
 
@@ -39,6 +40,7 @@ import Name
 import Type
 import PrelNames
 import TysWiredIn
+import TysPrim
 import Literal
 import SrcLoc
 import Data.Ratio
@@ -106,19 +108,15 @@ dsLit l = do
                     x -> pprPanic "dsLit" (ppr x)
 
 dsOverLit :: HsOverLit GhcTc -> DsM CoreExpr
-dsOverLit lit = do { dflags <- getDynFlags
-                   ; warnAboutOverflowedLiterals dflags lit
-                   ; dsOverLit' dflags lit }
-
-dsOverLit' :: DynFlags -> HsOverLit GhcTc -> DsM CoreExpr
--- Post-typechecker, the HsExpr field of an OverLit contains
--- (an expression for) the literal value itself
-dsOverLit' dflags (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
-                           , ol_witness = witness })
-  | not rebindable
-  , Just expr <- shortCutLit dflags val ty = dsExpr expr        -- Note [Literal short cut]
-  | otherwise                              = dsExpr witness
-dsOverLit' _ XOverLit{} = panic "dsOverLit'"
+-- ^ Post-typechecker, the 'HsExpr' field of an 'OverLit' contains
+-- (an expression for) the literal value itself.
+dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
+                   , ol_witness = witness }) = do
+  dflags <- getDynFlags
+  case shortCutLit dflags val ty of
+    Just expr | not rebindable -> dsExpr expr        -- Note [Literal short cut]
+    _                          -> dsExpr witness
+dsOverLit XOverLit{} = panic "dsOverLit"
 {-
 Note [Literal short cut]
 ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -158,11 +156,33 @@ conversionNames
  -- We can't easily add fromIntegerName, fromRationalName,
  -- because they are generated by literals
 
-warnAboutOverflowedLiterals :: DynFlags -> HsOverLit GhcTc -> DsM ()
+
+-- | Emit warnings on overloaded integral literals which overflow the bounds
+-- implied by their type.
+warnAboutOverflowedOverLit :: HsOverLit GhcTc -> DsM ()
+warnAboutOverflowedOverLit hsOverLit = do
+  dflags <- getDynFlags
+  warnAboutOverflowedLiterals dflags (getIntegralLit hsOverLit)
+
+-- | Emit warnings on integral literals which overflow the boudns implied by
+-- their type.
+warnAboutOverflowedLit :: HsLit GhcTc -> DsM ()
+warnAboutOverflowedLit hsLit = do
+  dflags <- getDynFlags
+  warnAboutOverflowedLiterals dflags (getSimpleIntegralLit hsLit)
+
+-- | Emit warnings on integral literals which overflow the bounds implied by
+-- their type.
+warnAboutOverflowedLiterals
+  :: DynFlags
+  -> Maybe (Integer, Name)  -- ^ the literal value and name of its tycon
+  -> DsM ()
 warnAboutOverflowedLiterals dflags lit
  | wopt Opt_WarnOverflowedLiterals dflags
- , Just (i, tc) <- getIntegralLit lit
-  = if      tc == intTyConName     then check i tc (Proxy :: Proxy Int)
+ , Just (i, tc) <- lit
+ =  if      tc == intTyConName     then check i tc (Proxy :: Proxy Int)
+
+    -- These only show up via the 'HsOverLit' route
     else if tc == int8TyConName    then check i tc (Proxy :: Proxy Int8)
     else if tc == int16TyConName   then check i tc (Proxy :: Proxy Int16)
     else if tc == int32TyConName   then check i tc (Proxy :: Proxy Int32)
@@ -173,10 +193,22 @@ warnAboutOverflowedLiterals dflags lit
     else if tc == word32TyConName  then check i tc (Proxy :: Proxy Word32)
     else if tc == word64TyConName  then check i tc (Proxy :: Proxy Word64)
     else if tc == naturalTyConName then checkPositive i tc
+
+    -- These only show up via the 'HsLit' route
+    else if tc == intPrimTyConName    then check i tc (Proxy :: Proxy Int)
+    else if tc == int8PrimTyConName   then check i tc (Proxy :: Proxy Int8)
+    else if tc == int32PrimTyConName  then check i tc (Proxy :: Proxy Int32)
+    else if tc == int64PrimTyConName  then check i tc (Proxy :: Proxy Int64)
+    else if tc == wordPrimTyConName   then check i tc (Proxy :: Proxy Word)
+    else if tc == word8PrimTyConName  then check i tc (Proxy :: Proxy Word8)
+    else if tc == word32PrimTyConName then check i tc (Proxy :: Proxy Word32)
+    else if tc == word64PrimTyConName then check i tc (Proxy :: Proxy Word64)
+
     else return ()
 
   | otherwise = return ()
   where
+
     checkPositive :: Integer -> Name -> DsM ()
     checkPositive i tc
       = when (i < 0) $ do
@@ -217,8 +249,8 @@ but perhaps that does not matter too much.
 
 warnAboutEmptyEnumerations :: DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc)
                            -> LHsExpr GhcTc -> DsM ()
--- Warns about [2,3 .. 1] which returns the empty list
--- Only works for integral types, not floating point
+-- ^ Warns about @[2,3 .. 1]@ which returns the empty list.
+-- Only works for integral types, not floating point.
 warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
   | wopt Opt_WarnEmptyEnumerations dflags
   , Just (from,tc) <- getLHsIntegralLit fromExpr
@@ -245,25 +277,44 @@ warnAboutEmptyEnumerations dflags fromExpr mThnExpr toExpr
     else if tc == word32TyConName then check (Proxy :: Proxy Word32)
     else if tc == word64TyConName then check (Proxy :: Proxy Word64)
     else if tc == integerTyConName then check (Proxy :: Proxy Integer)
+    else if tc == naturalTyConName then check (Proxy :: Proxy Integer)
+      -- We use 'Integer' because otherwise a negative 'Natural' literal
+      -- could cause a compile time crash (instead of a runtime one).
+      -- See the T10930b test case for an example of where this matters.
     else return ()
 
   | otherwise = return ()
 
 getLHsIntegralLit :: LHsExpr GhcTc -> Maybe (Integer, Name)
--- See if the expression is an Integral literal
+-- ^ See if the expression is an 'Integral' literal.
 -- Remember to look through automatically-added tick-boxes! (Trac #8384)
 getLHsIntegralLit (dL->L _ (HsPar _ e))            = getLHsIntegralLit e
 getLHsIntegralLit (dL->L _ (HsTick _ _ e))         = getLHsIntegralLit e
 getLHsIntegralLit (dL->L _ (HsBinTick _ _ _ e))    = getLHsIntegralLit e
 getLHsIntegralLit (dL->L _ (HsOverLit _ over_lit)) = getIntegralLit over_lit
+getLHsIntegralLit (dL->L _ (HsLit _ lit))          = getSimpleIntegralLit lit
 getLHsIntegralLit _ = Nothing
 
+-- | If 'Integral', extract the value and type name of the overloaded literal.
 getIntegralLit :: HsOverLit GhcTc -> Maybe (Integer, Name)
 getIntegralLit (OverLit { ol_val = HsIntegral i, ol_ext = OverLitTc _ ty })
   | Just tc <- tyConAppTyCon_maybe ty
   = Just (il_value i, tyConName tc)
 getIntegralLit _ = Nothing
 
+-- | If 'Integral', extract the value and type name of the non-overloaded
+-- literal.
+getSimpleIntegralLit :: HsLit GhcTc -> Maybe (Integer, Name)
+getSimpleIntegralLit (HsInt _ IL{ il_value = i }) = Just (i, intTyConName)
+getSimpleIntegralLit (HsIntPrim _ i) = Just (i, intPrimTyConName)
+getSimpleIntegralLit (HsWordPrim _ i) = Just (i, wordPrimTyConName)
+getSimpleIntegralLit (HsInt64Prim _ i) = Just (i, int64PrimTyConName)
+getSimpleIntegralLit (HsWord64Prim _ i) = Just (i, word64PrimTyConName)
+getSimpleIntegralLit (HsInteger _ i ty)
+  | Just tc <- tyConAppTyCon_maybe ty
+  = Just (i, tyConName tc)
+getSimpleIntegralLit _ = Nothing
+
 {-
 ************************************************************************
 *                                                                      *
@@ -369,10 +420,10 @@ matchLiterals (var:vars) ty sub_groups
   where
     match_group :: [EquationInfo] -> DsM (Literal, MatchResult)
     match_group eqns
-        = do dflags <- getDynFlags
-             let LitPat _ hs_lit = firstPat (head eqns)
-             match_result <- match vars ty (shiftEqns eqns)
-             return (hsLitKey dflags hs_lit, match_result)
+        = do { dflags <- getDynFlags
+             ; let LitPat _ hs_lit = firstPat (head eqns)
+             ; match_result <- match vars ty (shiftEqns eqns)
+             ; return (hsLitKey dflags hs_lit, match_result) }
 
     wrap_str_guard :: Id -> (Literal,MatchResult) -> DsM MatchResult
         -- Equality check for string literals
diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index 10034de650..77ea80eb0b 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -66,17 +66,17 @@ module TysPrim(
         weakPrimTyCon,                  mkWeakPrimTy,
         threadIdPrimTyCon,              threadIdPrimTy,
 
-        int8PrimTyCon,          int8PrimTy,
-        word8PrimTyCon,         word8PrimTy,
+        int8PrimTyCon,          int8PrimTy, int8PrimTyConName,
+        word8PrimTyCon,         word8PrimTy, word8PrimTyConName,
 
-        int16PrimTyCon,         int16PrimTy,
-        word16PrimTyCon,        word16PrimTy,
+        int16PrimTyCon,         int16PrimTy, int16PrimTyConName,
+        word16PrimTyCon,        word16PrimTy, word16PrimTyConName,
 
-        int32PrimTyCon,         int32PrimTy,
-        word32PrimTyCon,        word32PrimTy,
+        int32PrimTyCon,         int32PrimTy, int32PrimTyConName,
+        word32PrimTyCon,        word32PrimTy, word32PrimTyConName,
 
-        int64PrimTyCon,         int64PrimTy,
-        word64PrimTyCon,        word64PrimTy,
+        int64PrimTyCon,         int64PrimTy, int64PrimTyConName,
+        word64PrimTyCon,        word64PrimTy, word64PrimTyConName,
 
         eqPrimTyCon,            -- ty1 ~# ty2
         eqReprPrimTyCon,        -- ty1 ~R# ty2  (at role Representational)