Commit 8bdcc5cf authored by Ian Lynagh's avatar Ian Lynagh
Browse files

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).
parent a12c8a00
...@@ -63,6 +63,7 @@ import Maybes ...@@ -63,6 +63,7 @@ import Maybes
import OrdList import OrdList
import Bag import Bag
import BasicTypes hiding ( TopLevel ) import BasicTypes hiding ( TopLevel )
import DynFlags
import FastString import FastString
import ErrUtils( MsgDoc ) import ErrUtils( MsgDoc )
import Util import Util
...@@ -429,7 +430,9 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) ...@@ -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_rhs = dsHsWrapper spec_co poly_rhs
spec_pair = makeCorePair spec_id False (dictArity bndrs) spec_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)) ; return (Just (spec_pair `consOL` unf_pairs, rule))
} } } } } }
where where
......
...@@ -29,7 +29,7 @@ module DynFlags ( ...@@ -29,7 +29,7 @@ module DynFlags (
xopt_set, xopt_set,
xopt_unset, xopt_unset,
DynFlags(..), DynFlags(..),
HasDynFlags(..), HasDynFlags(..), ContainsDynFlags(..),
RtsOptsEnabled(..), RtsOptsEnabled(..),
HscTarget(..), isObjectTarget, defaultObjectTarget, HscTarget(..), isObjectTarget, defaultObjectTarget,
GhcMode(..), isOneShot, GhcMode(..), isOneShot,
...@@ -348,6 +348,7 @@ data WarningFlag = ...@@ -348,6 +348,7 @@ data WarningFlag =
| Opt_WarnAlternativeLayoutRuleTransitional | Opt_WarnAlternativeLayoutRuleTransitional
| Opt_WarnUnsafe | Opt_WarnUnsafe
| Opt_WarnSafe | Opt_WarnSafe
| Opt_WarnPointlessPragmas
deriving (Eq, Show, Enum) deriving (Eq, Show, Enum)
data Language = Haskell98 | Haskell2010 data Language = Haskell98 | Haskell2010
...@@ -596,6 +597,9 @@ data DynFlags = DynFlags { ...@@ -596,6 +597,9 @@ data DynFlags = DynFlags {
class HasDynFlags m where class HasDynFlags m where
getDynFlags :: m DynFlags getDynFlags :: m DynFlags
class ContainsDynFlags t where
extractDynFlags :: t -> DynFlags
data ProfAuto data ProfAuto
= NoProfAuto -- ^ no SCC annotations added = NoProfAuto -- ^ no SCC annotations added
| ProfAutoAll -- ^ top-level and nested functions are annotated | ProfAutoAll -- ^ top-level and nested functions are annotated
...@@ -1790,7 +1794,8 @@ fWarningFlags = [ ...@@ -1790,7 +1794,8 @@ fWarningFlags = [
( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ), ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ),
( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ), ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
( "warn-unsafe", Opt_WarnUnsafe, setWarnUnsafe ), ( "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\>@ -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
fFlags :: [FlagSpec DynFlag] fFlags :: [FlagSpec DynFlag]
...@@ -2115,7 +2120,8 @@ standardWarnings ...@@ -2115,7 +2120,8 @@ standardWarnings
Opt_WarnLazyUnliftedBindings, Opt_WarnLazyUnliftedBindings,
Opt_WarnDodgyForeignImports, Opt_WarnDodgyForeignImports,
Opt_WarnWrongDoBind, Opt_WarnWrongDoBind,
Opt_WarnAlternativeLayoutRuleTransitional Opt_WarnAlternativeLayoutRuleTransitional,
Opt_WarnPointlessPragmas
] ]
minusWOpts :: [WarningFlag] minusWOpts :: [WarningFlag]
......
...@@ -116,6 +116,7 @@ import UniqSupply ...@@ -116,6 +116,7 @@ import UniqSupply
import Unique import Unique
import BasicTypes import BasicTypes
import Bag import Bag
import DynFlags
import Outputable import Outputable
import ListSetOps import ListSetOps
import FastString import FastString
...@@ -187,6 +188,9 @@ data Env gbl lcl ...@@ -187,6 +188,9 @@ data Env gbl lcl
env_lcl :: lcl -- Nested stuff; changes as we go into 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 -- TcGblEnv describes the top-level of the module at the
-- point at which the typechecker is finished work. -- point at which the typechecker is finished work.
-- It is this structure that is handed on to the desugarer -- It is this structure that is handed on to the desugarer
......
...@@ -30,6 +30,7 @@ module IOEnv ( ...@@ -30,6 +30,7 @@ module IOEnv (
atomicUpdMutVar, atomicUpdMutVar' atomicUpdMutVar, atomicUpdMutVar'
) where ) where
import DynFlags
import Exception import Exception
import Panic import Panic
...@@ -88,6 +89,10 @@ instance Show IOEnvFailure where ...@@ -88,6 +89,10 @@ instance Show IOEnvFailure where
instance Exception IOEnvFailure instance Exception IOEnvFailure
instance ContainsDynFlags env => HasDynFlags (IOEnv env) where
getDynFlags = do env <- getEnv
return $ extractDynFlags env
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- Fundmantal combinators specific to the monad -- Fundmantal combinators specific to the monad
---------------------------------------------------------------------- ----------------------------------------------------------------------
......
...@@ -66,6 +66,9 @@ libraries/Cabal/Cabal_dist-install_EXTRA_HC_OPTS += -w ...@@ -66,6 +66,9 @@ libraries/Cabal/Cabal_dist-install_EXTRA_HC_OPTS += -w
# Temporarily turn off incomplete-pattern warnings for containers # Temporarily turn off incomplete-pattern warnings for containers
libraries/containers_dist-install_EXTRA_HC_OPTS += -fno-warn-incomplete-patterns 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 # bytestring has identities at the moment
libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-identities libraries/bytestring_dist-install_EXTRA_HC_OPTS += -fno-warn-identities
......
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