Commit abb3a9fa authored by ian@well-typed.com's avatar ian@well-typed.com

Add a warning for empty enumerations; fixes #7881

We now give a warning about enumerations like [5 .. 3] :: Int8.
parent 02b7c1c8
......@@ -60,6 +60,7 @@ import FastString
import Control.Monad
import Data.Int
import Data.Traversable (traverse)
import Data.Typeable (typeOf)
import Data.Word
\end{code}
......@@ -718,11 +719,24 @@ dsArithSeq :: PostTcExpr -> (ArithSeqInfo Id) -> DsM CoreExpr
dsArithSeq expr (From from)
= App <$> dsExpr expr <*> dsLExpr from
dsArithSeq expr (FromTo from to)
= mkApps <$> dsExpr expr <*> mapM dsLExpr [from, to]
= do expr' <- dsExpr expr
from' <- dsLExpr from
to' <- dsLExpr to
warn_empty_enumerations <- woptM Opt_WarnEmptyEnumerations
when warn_empty_enumerations $
warnAboutEmptyEnumerations from' Nothing to'
return $ mkApps expr' [from', to']
dsArithSeq expr (FromThen from thn)
= mkApps <$> dsExpr expr <*> mapM dsLExpr [from, thn]
dsArithSeq expr (FromThenTo from thn to)
= mkApps <$> dsExpr expr <*> mapM dsLExpr [from, thn, to]
= do expr' <- dsExpr expr
from' <- dsLExpr from
thn' <- dsLExpr thn
to' <- dsLExpr to
warn_empty_enumerations <- woptM Opt_WarnEmptyEnumerations
when warn_empty_enumerations $
warnAboutEmptyEnumerations from' (Just thn') to'
return $ mkApps expr' [from', thn', to']
\end{code}
Desugar 'do' and 'mdo' expressions (NOT list comprehensions, they're
......@@ -869,6 +883,45 @@ warnAboutOverflowedLiterals (App (App (App (Var f) (Type t)) _) (Lit (LitInteger
warnAboutOverflowedLiterals _ = return ()
\end{code}
\begin{code}
warnAboutEmptyEnumerations :: CoreExpr -> Maybe CoreExpr -> CoreExpr -> DsM ()
warnAboutEmptyEnumerations fromExpr mThnExpr toExpr
| Just from <- getVal fromExpr
, Just mThn <- traverse getVal mThnExpr
, Just to <- getVal toExpr
, Just t <- getType fromExpr
= let check proxy
= let enumeration
= case mThn of
Nothing -> [(fromInteger from `asTypeOf` proxy) .. fromInteger to]
Just thn -> [fromInteger from, fromInteger thn .. fromInteger to]
in when (null enumeration) $
warnDs (ptext (sLit "Enumeration is empty"))
in if t == intTyConName then check (undefined :: Int)
else if t == int8TyConName then check (undefined :: Int8)
else if t == int16TyConName then check (undefined :: Int16)
else if t == int32TyConName then check (undefined :: Int32)
else if t == int64TyConName then check (undefined :: Int64)
else if t == wordTyConName then check (undefined :: Word)
else if t == word8TyConName then check (undefined :: Word8)
else if t == word16TyConName then check (undefined :: Word16)
else if t == word32TyConName then check (undefined :: Word32)
else if t == word64TyConName then check (undefined :: Word64)
else return ()
where getVal (App (App (App (Var f) (Type _)) _) (Lit (LitInteger i _)))
| idName f == fromIntegerName = Just i
getVal _ = Nothing
getType (App (App (App (Var f) (Type t)) _) (Lit (LitInteger _ _)))
| idName f == fromIntegerName,
Just tc <- tyConAppTyCon_maybe t = Just (tyConName tc)
getType _ = Nothing
warnAboutEmptyEnumerations _ _ _ = return ()
\end{code}
%************************************************************************
%* *
\subsection{Errors and contexts}
......
......@@ -414,6 +414,7 @@ data WarningFlag =
| Opt_WarnIncompleteUniPatterns
| Opt_WarnIncompletePatternsRecUpd
| Opt_WarnOverflowedLiterals
| Opt_WarnEmptyEnumerations
| Opt_WarnMissingFields
| Opt_WarnMissingImportList
| Opt_WarnMissingMethods
......@@ -2435,6 +2436,7 @@ fWarningFlags = [
( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ),
( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ),
( "warn-overflowed-literals", Opt_WarnOverflowedLiterals, nop ),
( "warn-empty-enumerations", Opt_WarnEmptyEnumerations, nop ),
( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ),
( "warn-duplicate-constraints", Opt_WarnDuplicateConstraints, nop ),
( "warn-hi-shadowing", Opt_WarnHiShadows, nop ),
......@@ -2866,6 +2868,7 @@ standardWarnings
Opt_WarnDuplicateConstraints,
Opt_WarnDuplicateExports,
Opt_WarnOverflowedLiterals,
Opt_WarnEmptyEnumerations,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnLazyUnliftedBindings,
......
......@@ -967,6 +967,7 @@ test.hs:(5,4)-(6,7):
<option>-fwarn-duplicate-constraints</option>,
<option>-fwarn-duplicate-exports</option>,
<option>-fwarn-overflowed-literals</option>,
<option>-fwarn-empty-enumerations</option>,
<option>-fwarn-missing-fields</option>,
<option>-fwarn-missing-methods</option>,
<option>-fwarn-lazy-unlifted-bindings</option>,
......@@ -1225,6 +1226,18 @@ foreign import "&amp;f" f :: FunPtr t
</listitem>
</varlistentry>
<varlistentry>
<term><option>-fwarn-empty-enumerations</option>:</term>
<listitem>
<indexterm><primary><option>-fwarn-empty-enumerations</option></primary>
</indexterm>
<para>
Causes a warning to be emitted if an enumeration is
empty, e.g. <literal>[5 .. 3]</literal>.
</para>
</listitem>
</varlistentry>
<varlistentry>
<term><option>-fwarn-lazy-unlifted-bindings</option>:</term>
<listitem>
......
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