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

7 files changed, 77 insertions, 45 deletions

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index b8b7106346..33c218c903 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -236,6 +236,7 @@ Library
         CmmType
         CmmUtils
         CmmLayoutStack
+        EnumSet
         MkGraph
         PprBase
         PprC
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 36603a472c..86091f5fc0 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -465,6 +465,7 @@ compiler_stage2_dll0_MODULES = \
 	DriverPhases \
 	DynFlags \
 	Encoding \
+	EnumSet \
 	ErrUtils \
 	Exception \
 	FamInstEnv \
diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs
index a0654b01e6..b21c2ce591 100644
--- a/compiler/iface/FlagChecker.hs
+++ b/compiler/iface/FlagChecker.hs
@@ -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)
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index e95796d23b..0ef6d5d61f 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -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))
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 3d6fa1609c..a6e0a7b54d 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -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
   }
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 8e9fd2253a..be998e3d78 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -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 ()
diff --git a/compiler/utils/EnumSet.hs b/compiler/utils/EnumSet.hs
new file mode 100644
index 0000000000..aa36b788aa
--- /dev/null
+++ b/compiler/utils/EnumSet.hs
@@ -0,0 +1,33 @@
+-- | 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