diff options
| -rw-r--r-- | compiler/deSugar/DsExpr.lhs | 39 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 3 | ||||
| -rw-r--r-- | docs/users_guide/using.xml | 13 |
3 files changed, 53 insertions, 2 deletions
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 136fc8c1c4..e2dd798928 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -54,9 +54,14 @@ import SrcLoc import Util import Bag import Outputable +import Literal +import TyCon import FastString import Control.Monad +import Data.Int +import Data.Typeable (typeOf) +import Data.Word \end{code} @@ -211,7 +216,10 @@ dsExpr (HsLamCase arg matches) ; return $ Lam arg_var $ bindNonRec discrim_var (Var arg_var) matching_code } dsExpr (HsApp fun arg) - = mkCoreAppDs <$> dsLExpr fun <*> dsLExpr arg + = do ds <- mkCoreAppDs <$> dsLExpr fun <*> dsLExpr arg + warn_overflowed_literals <- woptM Opt_WarnOverflowedLiterals + when warn_overflowed_literals $ warnAboutOverflowedLiterals ds + return ds dsExpr (HsUnboundVar _) = panic "dsExpr: HsUnboundVar" \end{code} @@ -805,7 +813,7 @@ mk_fail_msg dflags pat = "Pattern match failure in do expression at " ++ %************************************************************************ %* * - Warning about identities + Warnings %* * %************************************************************************ @@ -834,6 +842,33 @@ conversionNames -- because they are generated by literals \end{code} +\begin{code} +warnAboutOverflowedLiterals :: CoreExpr -> DsM () +warnAboutOverflowedLiterals (App (App (App (Var f) (Type t)) _) (Lit (LitInteger i _))) + | idName f == fromIntegerName, + Just tc <- tyConAppTyCon_maybe t, + let t = tyConName tc + = let checkOverflow proxy + = when (i < fromIntegral (minBound `asTypeOf` proxy) || + i > fromIntegral (maxBound `asTypeOf` proxy)) $ + warnDs (ptext (sLit "Literal") <+> integer i <+> + ptext (sLit "of type") <+> + text (show (typeOf proxy)) <+> + ptext (sLit "overflows")) + in if t == intTyConName then checkOverflow (undefined :: Int) + else if t == int8TyConName then checkOverflow (undefined :: Int8) + else if t == int16TyConName then checkOverflow (undefined :: Int16) + else if t == int32TyConName then checkOverflow (undefined :: Int32) + else if t == int64TyConName then checkOverflow (undefined :: Int64) + else if t == wordTyConName then checkOverflow (undefined :: Word) + else if t == word8TyConName then checkOverflow (undefined :: Word8) + else if t == word16TyConName then checkOverflow (undefined :: Word16) + else if t == word32TyConName then checkOverflow (undefined :: Word32) + else if t == word64TyConName then checkOverflow (undefined :: Word64) + else return () +warnAboutOverflowedLiterals _ = return () +\end{code} + %************************************************************************ %* * \subsection{Errors and contexts} diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 975ffecf05..eeb48bab8e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -413,6 +413,7 @@ data WarningFlag = | Opt_WarnIncompletePatterns | Opt_WarnIncompleteUniPatterns | Opt_WarnIncompletePatternsRecUpd + | Opt_WarnOverflowedLiterals | Opt_WarnMissingFields | Opt_WarnMissingImportList | Opt_WarnMissingMethods @@ -2432,6 +2433,7 @@ fWarningFlags = [ ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, nop ), ( "warn-dodgy-exports", Opt_WarnDodgyExports, nop ), ( "warn-dodgy-imports", Opt_WarnDodgyImports, nop ), + ( "warn-overflowed-literals", Opt_WarnOverflowedLiterals, nop ), ( "warn-duplicate-exports", Opt_WarnDuplicateExports, nop ), ( "warn-duplicate-constraints", Opt_WarnDuplicateConstraints, nop ), ( "warn-hi-shadowing", Opt_WarnHiShadows, nop ), @@ -2861,6 +2863,7 @@ standardWarnings Opt_WarnPointlessPragmas, Opt_WarnDuplicateConstraints, Opt_WarnDuplicateExports, + Opt_WarnOverflowedLiterals, Opt_WarnMissingFields, Opt_WarnMissingMethods, Opt_WarnLazyUnliftedBindings, diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index e882f8eefd..9e17bfb94b 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -966,6 +966,7 @@ test.hs:(5,4)-(6,7): <option>-fwarn-pointless-pragmas</option>, <option>-fwarn-duplicate-constraints</option>, <option>-fwarn-duplicate-exports</option>, + <option>-fwarn-overflowed-literals</option>, <option>-fwarn-missing-fields</option>, <option>-fwarn-missing-methods</option>, <option>-fwarn-lazy-unlifted-bindings</option>, @@ -1213,6 +1214,18 @@ foreign import "&f" f :: FunPtr t </varlistentry> <varlistentry> + <term><option>-fwarn-overflowed-literals</option>:</term> + <listitem> + <indexterm><primary><option>-fwarn-overflowed-literals</option></primary> + </indexterm> + <para> + Causes a warning to be emitted if a literal will overflow, + e.g. <literal>300 :: Word8</literal>. + </para> + </listitem> + </varlistentry> + + <varlistentry> <term><option>-fwarn-lazy-unlifted-bindings</option>:</term> <listitem> <indexterm><primary><option>-fwarn-lazy-unlifted-bindings</option></primary> |