Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : fix-5624
http://hackage.haskell.org/trac/ghc/changeset/674c005eab4e25a4af151e090a813726c24b0d39 >--------------------------------------------------------------- commit 674c005eab4e25a4af151e090a813726c24b0d39 Author: Jose Pedro Magalhaes <[email protected]> Date: Fri Dec 2 11:59:52 2011 +0000 Rename the flag to -fwarn-type-errors >--------------------------------------------------------------- compiler/hsSyn/HsBinds.lhs | 2 +- compiler/main/DynFlags.hs | 6 +++--- compiler/typecheck/TcErrors.lhs | 2 +- compiler/typecheck/TcSimplify.lhs | 4 ++-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 65ef3b1..e6edc09 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -542,7 +542,7 @@ data EvTerm -- dictionaries, even though the former have no -- selector Id. We count up from _0_ - | EvDelayedError Type WSDoc -- Used with Opt_RuntimeCoercionErrors + | EvDelayedError Type WSDoc -- Used with Opt_WarnTypeErrors -- See Note [Deferring coercion errors to runtime] -- in TcSimplify diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5baf190..23f2f8e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -287,7 +287,6 @@ data DynFlag | Opt_GhciSandbox | Opt_GhciHistory | Opt_HelpfulErrors - | Opt_RuntimeCoercionErrors -- temporary flags | Opt_RunCPS @@ -345,6 +344,7 @@ data WarningFlag = | Opt_WarnAlternativeLayoutRuleTransitional | Opt_WarnUnsafe | Opt_WarnSafe + | Opt_WarnTypeErrors deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -1763,7 +1763,8 @@ fWarningFlags = [ ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ), ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ), ( "warn-unsafe", Opt_WarnUnsafe, setWarnUnsafe ), - ( "warn-safe", Opt_WarnSafe, setWarnSafe ) ] + ( "warn-safe", Opt_WarnSafe, setWarnSafe ), + ( "warn-type-errors", Opt_WarnTypeErrors, nop ) ] -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@ fFlags :: [FlagSpec DynFlag] @@ -1811,7 +1812,6 @@ fFlags = [ ( "ghci-sandbox", Opt_GhciSandbox, nop ), ( "ghci-history", Opt_GhciHistory, nop ), ( "helpful-errors", Opt_HelpfulErrors, nop ), - ( "runtime-coercion-errors", Opt_RuntimeCoercionErrors, nop ), ( "building-cabal-package", Opt_BuildingCabalPackage, nop ), ( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ), ( "prof-count-entries", Opt_ProfCountEntries, nop ), diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index f2f8dfe..cf5e021 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -111,7 +111,7 @@ reportTidyImplic ctxt implic reportTidyWanteds :: ReportErrCtxt -> WantedConstraints -> TcM () reportTidyWanteds ctxt (WC { wc_flat = flats, wc_insol = insols, wc_impl = implics }) - = do { runtimeCoercionErrors <- doptM Opt_RuntimeCoercionErrors + = do { runtimeCoercionErrors <- woptM Opt_WarnTypeErrors ; let (given, other) = partitionBag (isGivenOrSolved . cc_flavor) insols insol_implics = filterBag ic_insol implics flat_evs = bagToList $ mapBag to_wev flats diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index e804333..fdeeb08 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -38,7 +38,7 @@ import PrelInfo import PrelNames import Class ( classKey ) import BasicTypes ( RuleName ) -import DynFlags ( DynFlag( Opt_RuntimeCoercionErrors ) ) +import DynFlags ( WarningFlag( Opt_WarnTypeErrors ) ) import Control.Monad ( when, unless ) import Outputable import FastString @@ -701,7 +701,7 @@ reportOrDefer :: Bool -> SimplContext -> WantedConstraints -> TcM (Bag EvBind) reportOrDefer should_fail ctxt unsolved - = do { runtimeCoercionErrors <- doptM Opt_RuntimeCoercionErrors + = do { runtimeCoercionErrors <- woptM Opt_WarnTypeErrors -- If we're deferring errors to runtime ; if runtimeCoercionErrors then do { _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
