Commit cc9d574a authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Introduce and use EnumSet in DynFlags

This factors out a repeated pattern found in DynFlags, where we use an
IntSet and Enum to represent sets of flags.

Requires bump of haddock submodule.

Test Plan: validate

Reviewers: austin, goldfire

Subscribers: rwbarton, thomie, snowleopard

Differential Revision: https://phabricator.haskell.org/D3331
parent a7be1631
......@@ -236,6 +236,7 @@ Library
CmmType
CmmUtils
CmmLayoutStack
EnumSet
MkGraph
PprBase
PprC
......
......@@ -465,6 +465,7 @@ compiler_stage2_dll0_MODULES = \
DriverPhases \
DynFlags \
Encoding \
EnumSet \
ErrUtils \
Exception \
FamInstEnv \
......
......@@ -16,7 +16,7 @@ import Fingerprint
import BinFingerprint
-- import Outputable
import qualified Data.IntSet as IntSet
import qualified EnumSet
import System.FilePath (normalise)
-- | Produce a fingerprint of a @DynFlags@ value. We only base
......@@ -39,7 +39,7 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
-- *all* the extension flags and the language
lang = (fmap fromEnum language,
IntSet.toList $ extensionFlags)
map fromEnum $ EnumSet.toList extensionFlags)
-- -I, -D and -U flags affect CPP
cpp = (map normalise includePaths, opt_P dflags ++ picPOpts dflags)
......
......@@ -210,8 +210,8 @@ import System.IO.Error
import Text.ParserCombinators.ReadP hiding (char)
import Text.ParserCombinators.ReadP as R
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import EnumSet (EnumSet)
import qualified EnumSet
import GHC.Foreign (withCString, peekCString)
import qualified GHC.LanguageExtensions as LangExt
......@@ -836,10 +836,10 @@ data DynFlags = DynFlags {
generatedDumps :: IORef (Set FilePath),
-- hsc dynamic flags
dumpFlags :: IntSet,
generalFlags :: IntSet,
warningFlags :: IntSet,
fatalWarningFlags :: IntSet,
dumpFlags :: EnumSet DumpFlag,
generalFlags :: EnumSet GeneralFlag,
warningFlags :: EnumSet WarningFlag,
fatalWarningFlags :: EnumSet WarningFlag,
-- Don't change this without updating extensionFlags:
language :: Maybe Language,
-- | Safe Haskell mode
......@@ -863,7 +863,7 @@ data DynFlags = DynFlags {
-- flattenExtensionFlags language extensions
-- LangExt.Extension is defined in libraries/ghc-boot so that it can be used
-- by template-haskell
extensionFlags :: IntSet,
extensionFlags :: EnumSet LangExt.Extension,
-- Unfolding control
-- See Note [Discounts and thresholds] in CoreUnfold
......@@ -1614,10 +1614,10 @@ defaultDynFlags mySettings =
filesToNotIntermediateClean = panic "defaultDynFlags: No filesToNotIntermediateClean",
generatedDumps = panic "defaultDynFlags: No generatedDumps",
haddockOptions = Nothing,
dumpFlags = IntSet.empty,
generalFlags = IntSet.fromList (map fromEnum (defaultFlags mySettings)),
warningFlags = IntSet.fromList (map fromEnum standardWarnings),
fatalWarningFlags = IntSet.empty,
dumpFlags = EnumSet.empty,
generalFlags = EnumSet.fromList (defaultFlags mySettings),
warningFlags = EnumSet.fromList standardWarnings,
fatalWarningFlags = EnumSet.empty,
ghciScripts = [],
language = Nothing,
safeHaskell = Sf_None,
......@@ -1861,11 +1861,11 @@ instance Outputable a => Outputable (OnOff a) where
-- OnOffs accumulate in reverse order, so we use foldr in order to
-- process them in the right order
flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> IntSet
flattenExtensionFlags :: Maybe Language -> [OnOff LangExt.Extension] -> EnumSet LangExt.Extension
flattenExtensionFlags ml = foldr f defaultExtensionFlags
where f (On f) flags = IntSet.insert (fromEnum f) flags
f (Off f) flags = IntSet.delete (fromEnum f) flags
defaultExtensionFlags = IntSet.fromList (map fromEnum (languageExtensions ml))
where f (On f) flags = EnumSet.insert f flags
f (Off f) flags = EnumSet.delete f flags
defaultExtensionFlags = EnumSet.fromList (languageExtensions ml)
languageExtensions :: Maybe Language -> [LangExt.Extension]
......@@ -1920,7 +1920,7 @@ hasNoOptCoercion = gopt Opt_G_NoOptCoercion
-- | Test whether a 'DumpFlag' is set
dopt :: DumpFlag -> DynFlags -> Bool
dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags)
dopt f dflags = (f `EnumSet.member` dumpFlags dflags)
|| (verbosity dflags >= 4 && enableIfVerbose f)
where enableIfVerbose Opt_D_dump_tc_trace = False
enableIfVerbose Opt_D_dump_rn_trace = False
......@@ -1954,55 +1954,53 @@ dopt f dflags = (fromEnum f `IntSet.member` dumpFlags dflags)
-- | Set a 'DumpFlag'
dopt_set :: DynFlags -> DumpFlag -> DynFlags
dopt_set dfs f = dfs{ dumpFlags = IntSet.insert (fromEnum f) (dumpFlags dfs) }
dopt_set dfs f = dfs{ dumpFlags = EnumSet.insert f (dumpFlags dfs) }
-- | Unset a 'DumpFlag'
dopt_unset :: DynFlags -> DumpFlag -> DynFlags
dopt_unset dfs f = dfs{ dumpFlags = IntSet.delete (fromEnum f) (dumpFlags dfs) }
dopt_unset dfs f = dfs{ dumpFlags = EnumSet.delete f (dumpFlags dfs) }
-- | Test whether a 'GeneralFlag' is set
gopt :: GeneralFlag -> DynFlags -> Bool
gopt f dflags = fromEnum f `IntSet.member` generalFlags dflags
gopt f dflags = f `EnumSet.member` generalFlags dflags
-- | Set a 'GeneralFlag'
gopt_set :: DynFlags -> GeneralFlag -> DynFlags
gopt_set dfs f = dfs{ generalFlags = IntSet.insert (fromEnum f) (generalFlags dfs) }
gopt_set dfs f = dfs{ generalFlags = EnumSet.insert f (generalFlags dfs) }
-- | Unset a 'GeneralFlag'
gopt_unset :: DynFlags -> GeneralFlag -> DynFlags
gopt_unset dfs f = dfs{ generalFlags = IntSet.delete (fromEnum f) (generalFlags dfs) }
gopt_unset dfs f = dfs{ generalFlags = EnumSet.delete f (generalFlags dfs) }
-- | Test whether a 'WarningFlag' is set
wopt :: WarningFlag -> DynFlags -> Bool
wopt f dflags = fromEnum f `IntSet.member` warningFlags dflags
wopt f dflags = f `EnumSet.member` warningFlags dflags
-- | Set a 'WarningFlag'
wopt_set :: DynFlags -> WarningFlag -> DynFlags
wopt_set dfs f = dfs{ warningFlags = IntSet.insert (fromEnum f) (warningFlags dfs) }
wopt_set dfs f = dfs{ warningFlags = EnumSet.insert f (warningFlags dfs) }
-- | Unset a 'WarningFlag'
wopt_unset :: DynFlags -> WarningFlag -> DynFlags
wopt_unset dfs f = dfs{ warningFlags = IntSet.delete (fromEnum f) (warningFlags dfs) }
wopt_unset dfs f = dfs{ warningFlags = EnumSet.delete f (warningFlags dfs) }
-- | Test whether a 'WarningFlag' is set as fatal
wopt_fatal :: WarningFlag -> DynFlags -> Bool
wopt_fatal f dflags = fromEnum f `IntSet.member` fatalWarningFlags dflags
wopt_fatal f dflags = f `EnumSet.member` fatalWarningFlags dflags
-- | Mark a 'WarningFlag' as fatal (do not set the flag)
wopt_set_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_set_fatal dfs f
= dfs { fatalWarningFlags =
IntSet.insert (fromEnum f) (fatalWarningFlags dfs) }
= dfs { fatalWarningFlags = EnumSet.insert f (fatalWarningFlags dfs) }
-- | Mark a 'WarningFlag' as not fatal
wopt_unset_fatal :: DynFlags -> WarningFlag -> DynFlags
wopt_unset_fatal dfs f
= dfs { fatalWarningFlags =
IntSet.delete (fromEnum f) (fatalWarningFlags dfs) }
= dfs { fatalWarningFlags = EnumSet.delete f (fatalWarningFlags dfs) }
-- | Test whether a 'LangExt.Extension' is set
xopt :: LangExt.Extension -> DynFlags -> Bool
xopt f dflags = fromEnum f `IntSet.member` extensionFlags dflags
xopt f dflags = f `EnumSet.member` extensionFlags dflags
-- | Set a 'LangExt.Extension'
xopt_set :: DynFlags -> LangExt.Extension -> DynFlags
......@@ -3063,10 +3061,10 @@ dynamic_flags_deps = [
-- Opt_WarnIsError is still needed to pass -Werror
-- to CPP; see runCpp in SysTools
, make_dep_flag defFlag "Wnot" (NoArg (upd (\d ->
d {warningFlags = IntSet.empty})))
d {warningFlags = EnumSet.empty})))
"Use -w or -Wno-everything instead"
, make_ord_flag defFlag "w" (NoArg (upd (\d ->
d {warningFlags = IntSet.empty})))
d {warningFlags = EnumSet.empty})))
-- New-style uniform warning sets
--
......@@ -3074,7 +3072,7 @@ dynamic_flags_deps = [
, make_ord_flag defFlag "Weverything" (NoArg (mapM_
setWarningFlag minusWeverythingOpts))
, make_ord_flag defFlag "Wno-everything"
(NoArg (upd (\d -> d {warningFlags = IntSet.empty})))
(NoArg (upd (\d -> d {warningFlags = EnumSet.empty})))
, make_ord_flag defFlag "Wall" (NoArg (mapM_
setWarningFlag minusWallOpts))
......
......@@ -86,8 +86,8 @@ import Data.List
import Data.Maybe
import Data.Word
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import EnumSet (EnumSet)
import qualified EnumSet
-- ghc-boot
import qualified GHC.LanguageExtensions as LangExt
......@@ -1798,16 +1798,16 @@ data ParseResult a
-- | Test whether a 'WarningFlag' is set
warnopt :: WarningFlag -> ParserFlags -> Bool
warnopt f options = fromEnum f `IntSet.member` pWarningFlags options
warnopt f options = f `EnumSet.member` pWarningFlags options
-- | Test whether a 'LangExt.Extension' is set
extopt :: LangExt.Extension -> ParserFlags -> Bool
extopt f options = fromEnum f `IntSet.member` pExtensionFlags options
extopt f options = f `EnumSet.member` pExtensionFlags options
-- | The subset of the 'DynFlags' used by the parser
data ParserFlags = ParserFlags {
pWarningFlags :: IntSet
, pExtensionFlags :: IntSet
pWarningFlags :: EnumSet WarningFlag
, pExtensionFlags :: EnumSet LangExt.Extension
, pThisPackage :: UnitId -- ^ key of package currently being compiled
, pExtsBitmap :: !ExtsBitmap -- ^ bitmap of permitted extensions
}
......
......@@ -103,6 +103,7 @@ import Maybes( MaybeErr(..) )
import DynFlags
import Panic
import Lexeme
import qualified EnumSet
import qualified Language.Haskell.TH as TH
-- THSyntax gives access to internal functions and data types
......@@ -111,7 +112,6 @@ import qualified Language.Haskell.TH.Syntax as TH
-- Because GHC.Desugar might not be in the base library of the bootstrapping compiler
import GHC.Desugar ( AnnotationWrapper(..) )
import qualified Data.IntSet as IntSet
import Control.Exception
import Data.Binary
import Data.Binary.Get
......@@ -931,9 +931,8 @@ instance TH.Quasi TcM where
qIsExtEnabled = xoptM
qExtsEnabled = do
dflags <- hsc_dflags <$> getTopEnv
return $ map toEnum $ IntSet.elems $ extensionFlags dflags
qExtsEnabled =
EnumSet.toList . extensionFlags . hsc_dflags <$> getTopEnv
-- | Adds a mod finalizer reference to the local environment.
addModFinalizerRef :: ForeignRef (TH.Q ()) -> TcM ()
......
-- | An tiny wrapper around 'IntSet.IntSet' for representing sets of 'Enum'
-- things.
module EnumSet
( EnumSet
, member
, insert
, delete
, toList
, fromList
, empty
) where
import qualified Data.IntSet as IntSet
newtype EnumSet a = EnumSet IntSet.IntSet
member :: Enum a => a -> EnumSet a -> Bool
member x (EnumSet s) = IntSet.member (fromEnum x) s
insert :: Enum a => a -> EnumSet a -> EnumSet a
insert x (EnumSet s) = EnumSet $ IntSet.insert (fromEnum x) s
delete :: Enum a => a -> EnumSet a -> EnumSet a
delete x (EnumSet s) = EnumSet $ IntSet.delete (fromEnum x) s
toList :: Enum a => EnumSet a -> [a]
toList (EnumSet s) = map toEnum $ IntSet.toList s
fromList :: Enum a => [a] -> EnumSet a
fromList = EnumSet . IntSet.fromList . map fromEnum
empty :: EnumSet a
empty = EnumSet IntSet.empty
Subproject commit 12a6cc9a98b79a4851fbe40a02c56652338d1c3e
Subproject commit af9c09feac6fbecc50140f3aac1bb58888addc63
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