Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8bdcc5cf6896260eb520f18fa2475af10a969dbe >--------------------------------------------------------------- commit 8bdcc5cf6896260eb520f18fa2475af10a969dbe Author: Ian Lynagh <[email protected]> Date: Thu Jan 19 12:51:22 2012 +0000 Fix validate This patch defines a flag -fno-warn-pointless-pragmas, and uses it to disable some warnings in the containers package. Along the way, also made a ContainsDynFlags class, and added a HasDynFlags instance for IOEnv (and thus TcRnIf and DsM). >--------------------------------------------------------------- compiler/deSugar/DsBinds.lhs | 5 ++++- compiler/main/DynFlags.hs | 12 +++++++++--- compiler/typecheck/TcRnTypes.lhs | 4 ++++ compiler/utils/IOEnv.hs | 5 +++++ mk/validate-settings.mk | 3 +++ 5 files changed, 25 insertions(+), 4 deletions(-) diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs index 232891f..1380774 100644 --- a/compiler/deSugar/DsBinds.lhs +++ b/compiler/deSugar/DsBinds.lhs @@ -63,6 +63,7 @@ import Maybes import OrdList import Bag import BasicTypes hiding ( TopLevel ) +import DynFlags import FastString import ErrUtils( MsgDoc ) import Util @@ -429,7 +430,9 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) spec_rhs = dsHsWrapper spec_co poly_rhs spec_pair = makeCorePair spec_id False (dictArity bndrs) spec_rhs - ; when (isInlinePragma id_inl) (warnDs (specOnInline poly_name)) + ; dflags <- getDynFlags + ; when (isInlinePragma id_inl && wopt Opt_WarnPointlessPragmas dflags) + (warnDs (specOnInline poly_name)) ; return (Just (spec_pair `consOL` unf_pairs, rule)) } } } where diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index bcd43e3..ac4df37 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -29,7 +29,7 @@ module DynFlags ( xopt_set, xopt_unset, DynFlags(..), - HasDynFlags(..), + HasDynFlags(..), ContainsDynFlags(..), RtsOptsEnabled(..), HscTarget(..), isObjectTarget, defaultObjectTarget, GhcMode(..), isOneShot, @@ -348,6 +348,7 @@ data WarningFlag = | Opt_WarnAlternativeLayoutRuleTransitional | Opt_WarnUnsafe | Opt_WarnSafe + | Opt_WarnPointlessPragmas deriving (Eq, Show, Enum) data Language = Haskell98 | Haskell2010 @@ -596,6 +597,9 @@ data DynFlags = DynFlags { class HasDynFlags m where getDynFlags :: m DynFlags +class ContainsDynFlags t where + extractDynFlags :: t -> DynFlags + data ProfAuto = NoProfAuto -- ^ no SCC annotations added | ProfAutoAll -- ^ top-level and nested functions are annotated @@ -1790,7 +1794,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-pointless-pragmas", Opt_WarnPointlessPragmas, nop ) ] -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@ fFlags :: [FlagSpec DynFlag] @@ -2115,7 +2120,8 @@ standardWarnings Opt_WarnLazyUnliftedBindings, Opt_WarnDodgyForeignImports, Opt_WarnWrongDoBind, - Opt_WarnAlternativeLayoutRuleTransitional + Opt_WarnAlternativeLayoutRuleTransitional, + Opt_WarnPointlessPragmas ] minusWOpts :: [WarningFlag] diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 015510f..8ff3ce3 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -116,6 +116,7 @@ import UniqSupply import Unique import BasicTypes import Bag +import DynFlags import Outputable import ListSetOps import FastString @@ -187,6 +188,9 @@ data Env gbl lcl env_lcl :: lcl -- Nested stuff; changes as we go into } +instance ContainsDynFlags (Env gbl lcl) where + extractDynFlags env = hsc_dflags (env_top env) + -- TcGblEnv describes the top-level of the module at the -- point at which the typechecker is finished work. -- It is this structure that is handed on to the desugarer diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs index c029e4a..ee7e616 100644 --- a/compiler/utils/IOEnv.hs +++ b/compiler/utils/IOEnv.hs @@ -30,6 +30,7 @@ module IOEnv ( atomicUpdMutVar, atomicUpdMutVar' ) where +import DynFlags import Exception import Panic @@ -88,6 +89,10 @@ instance Show IOEnvFailure where instance Exception IOEnvFailure +instance ContainsDynFlags env => HasDynFlags (IOEnv env) where + getDynFlags = do env <- getEnv + return $ extractDynFlags env + ---------------------------------------------------------------------- -- Fundmantal combinators specific to the monad ---------------------------------------------------------------------- diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk index 86bb73e..03b2a6f 100644 --- a/mk/validate-settings.mk +++ b/mk/validate-settings.mk @@ -66,6 +66,9 @@ libraries/Cabal/Cabal_dist-install_EXTRA_HC_OPTS += -w # Temporarily turn off incomplete-pattern warnings for containers libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-incomplete-patterns +# Temporarily turn off pointless-pragma warnings for containers +libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-pointless-pragmas + # bytestring has identities at the moment libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-identities _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
