Use a Set to represent Ways

Should make `member` queries faster and avoid messing up with missing
`nubSort`.

Metric Increase:
    hie002

12 files changed, 61 insertions, 52 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 256a414e64..11c1ce8521 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -336,6 +336,7 @@ import GHC.Driver.Finder
 import GHC.Driver.Types
 import GHC.Driver.CmdLine
 import GHC.Driver.Session hiding (WarnReason(..))
+import GHC.Driver.Ways
 import SysTools
 import SysTools.BaseDir
 import Annotations
@@ -365,6 +366,7 @@ import FileCleanup
 import Data.Foldable
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
+import qualified Data.Set as S
 import qualified Data.Sequence as Seq
 import Data.Maybe
 import Data.Time
@@ -542,10 +544,10 @@ checkBrokenTablesNextToCode dflags
 
 checkBrokenTablesNextToCode' :: MonadIO m => DynFlags -> m Bool
 checkBrokenTablesNextToCode' dflags
-  | not (isARM arch)              = return False
-  | WayDyn `notElem` ways dflags  = return False
-  | not (tablesNextToCode dflags) = return False
-  | otherwise                     = do
+  | not (isARM arch)                 = return False
+  | WayDyn `S.notMember` ways dflags = return False
+  | not (tablesNextToCode dflags)    = return False
+  | otherwise                        = do
     linkerInfo <- liftIO $ getLinkerInfo dflags
     case linkerInfo of
       GnuLD _  -> return True
@@ -605,9 +607,9 @@ setSessionDynFlags dflags = do
          let
            prog = pgm_i dflags ++ flavour
            flavour
-             | WayProf `elem` ways dflags = "-prof"
-             | WayDyn `elem` ways dflags  = "-dyn"
-             | otherwise                  = ""
+             | WayProf `S.member` ways dflags = "-prof"
+             | WayDyn `S.member` ways dflags  = "-dyn"
+             | otherwise                      = ""
            msg = text "Starting " <> text prog
          tr <- if verbosity dflags >= 3
                 then return (logInfo dflags (defaultDumpStyle dflags) msg)
@@ -617,7 +619,7 @@ setSessionDynFlags dflags = do
             { iservConfProgram  = prog
             , iservConfOpts     = getOpts dflags opt_i
             , iservConfProfiled = gopt Opt_SccProfilingOn dflags
-            , iservConfDynamic  = WayDyn `elem` ways dflags
+            , iservConfDynamic  = WayDyn `S.member` ways dflags
             , iservConfHook     = createIservProcessHook (hooks dflags)
             , iservConfTrace    = tr
             }
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index bfda490b85..55771b30a9 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -42,6 +42,7 @@ import MonadUtils
 import FastString
 import Util
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import ForeignCall
 import Demand           ( isUsedOnce )
 import PrimOp           ( PrimCall(..), primOpWrapperId )
@@ -51,6 +52,7 @@ import PrelNames        ( unsafeEqualityProofName )
 import Data.List.NonEmpty (nonEmpty, toList)
 import Data.Maybe    (fromMaybe)
 import Control.Monad (ap)
+import qualified Data.Set as Set
 
 -- Note [Live vs free]
 -- ~~~~~~~~~~~~~~~~~~~
@@ -230,7 +232,7 @@ coreToStg dflags this_mod pgm
     (_, (local_ccs, local_cc_stacks), pgm')
       = coreTopBindsToStg dflags this_mod emptyVarEnv emptyCollectedCCs pgm
 
-    prof = WayProf `elem` ways dflags
+    prof = WayProf `Set.member` ways dflags
 
     final_ccs
       | prof && gopt Opt_AutoSccsOnIndividualCafs dflags
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index f40cfeb286..859892cfbe 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -51,6 +51,7 @@ import Maybes
 import OrdList
 import ErrUtils
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import Util
 import Outputable
 import FastString
@@ -183,7 +184,7 @@ corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
     initialCorePrepEnv <- mkInitialCorePrepEnv dflags hsc_env
 
     let cost_centres
-          | WayProf `elem` ways dflags
+          | WayProf `S.member` ways dflags
           = collectCostCentres this_mod binds
           | otherwise
           = S.empty
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index bbd501fb26..7b621ca3c4 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -20,6 +20,7 @@ import GhcPrelude
 import qualified GHC
 import GHC.Driver.Monad
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import Util
 import GHC.Driver.Types
 import qualified SysTools
@@ -43,6 +44,7 @@ import System.IO.Error  ( isEOFError )
 import Control.Monad    ( when )
 import Data.Maybe       ( isJust )
 import Data.IORef
+import qualified Data.Set as Set
 
 -----------------------------------------------------------------
 --
@@ -62,8 +64,8 @@ doMkDependHS srcs = do
     -- way and .o/.hi extensions, regardless of any flags that might
     -- be specified.
     let dflags = dflags0 {
-                     ways = [],
-                     buildTag = waysTag [],
+                     ways = Set.empty,
+                     buildTag = waysTag Set.empty,
                      hiSuf = "hi",
                      objectSuf = "o"
                  }
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs
index 09eac60308..079bf6379f 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Driver/Packages.hs
@@ -71,6 +71,7 @@ import GhcPrelude
 import GHC.PackageDb
 import UnitInfo
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import Name             ( Name, nameModule_maybe )
 import UniqFM
 import UniqDFM
@@ -1839,22 +1840,22 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
   where
         ways0 = ways dflags
 
-        ways1 = filter (/= WayDyn) ways0
+        ways1 = Set.filter (/= WayDyn) ways0
         -- the name of a shared library is libHSfoo-ghc<version>.so
         -- we leave out the _dyn, because it is superfluous
 
         -- debug and profiled RTSs include support for -eventlog
-        ways2 | WayDebug `elem` ways1 || WayProf `elem` ways1
-              = filter (/= WayEventLog) ways1
+        ways2 | WayDebug `Set.member` ways1 || WayProf `Set.member` ways1
+              = Set.filter (/= WayEventLog) ways1
               | otherwise
               = ways1
 
-        tag     = waysTag (filter (not . wayRTSOnly) ways2)
+        tag     = waysTag (Set.filter (not . wayRTSOnly) ways2)
         rts_tag = waysTag ways2
 
         mkDynName x
-         | WayDyn `notElem` ways dflags = x
-         | "HS" `isPrefixOf` x          =
+         | WayDyn `Set.notMember` ways dflags = x
+         | "HS" `isPrefixOf` x                =
               x ++ '-':programName dflags ++ projectVersion dflags
            -- For non-Haskell libraries, we use the name "Cfoo". The .a
            -- file is libCfoo.a, and the .so is libfoo.so. That way the
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index d776e639b2..97dd1a6f07 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -64,8 +64,7 @@ module GHC.Driver.Session (
         optimisationFlags,
         setFlagsFromEnvFile,
 
-        Way(..), waysTag, wayRTSOnly, addWay', updateWays,
-        wayGeneralFlags, wayUnsetGeneralFlags,
+        addWay', updateWays,
 
         thisPackage, thisComponentId, thisUnitIdInsts,
 
@@ -533,7 +532,7 @@ data DynFlags = DynFlags {
   thisUnitIdInsts_      :: Maybe [(ModuleName, Module)],
 
   -- ways
-  ways                  :: [Way],       -- ^ Way flags from the command line
+  ways                  :: Set Way,     -- ^ Way flags from the command line
   buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
 
   -- For object splitting
@@ -1495,10 +1494,10 @@ defaultDynFlags mySettings llvmConfig =
         cfgWeightInfo = defaultCfgWeights
       }
 
-defaultWays :: Settings -> [Way]
+defaultWays :: Settings -> Set Way
 defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
-                       then [WayDyn]
-                       else []
+                       then Set.singleton WayDyn
+                       else Set.empty
 
 --------------------------------------------------------------------------
 --
@@ -2156,7 +2155,7 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
 
   unless (allowed_combination theWays) $ liftIO $
       throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
-                               intercalate "/" (map wayDesc theWays)))
+                               intercalate "/" (map wayDesc (Set.toAscList theWays))))
 
   let chooseOutput
         | isJust (outputFile dflags3)          -- Only iff user specified -o ...
@@ -2189,11 +2188,9 @@ putLogMsg dflags = log_action dflags dflags
 
 updateWays :: DynFlags -> DynFlags
 updateWays dflags
-    = let theWays = sort $ nub $ ways dflags
-      in dflags {
-             ways        = theWays,
-             buildTag    = waysTag (filter (not . wayRTSOnly) theWays)
-         }
+    = dflags {
+        buildTag = waysTag (Set.filter (not . wayRTSOnly) (ways dflags))
+      }
 
 -- | Check (and potentially disable) any extensions that aren't allowed
 -- in safe mode.
@@ -4401,7 +4398,7 @@ addWay w = upd (addWay' w)
 
 addWay' :: Way -> DynFlags -> DynFlags
 addWay' w dflags0 = let platform = targetPlatform dflags0
-                        dflags1 = dflags0 { ways = w : ways dflags0 }
+                        dflags1 = dflags0 { ways = Set.insert w (ways dflags0) }
                         dflags2 = foldr setGeneralFlag' dflags1
                                         (wayGeneralFlags platform w)
                         dflags3 = foldr unSetGeneralFlag' dflags2
@@ -4409,7 +4406,7 @@ addWay' w dflags0 = let platform = targetPlatform dflags0
                     in dflags3
 
 removeWayDyn :: DynP ()
-removeWayDyn = upd (\dfs -> dfs { ways = filter (WayDyn /=) (ways dfs) })
+removeWayDyn = upd (\dfs -> dfs { ways = Set.filter (WayDyn /=) (ways dfs) })
 
 --------------------------
 setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()
@@ -4832,7 +4829,7 @@ picCCOpts dflags = pieOpts ++ picOpts
       -- correctly.  They need to reference data in the Haskell
       -- objects, but can't without -fPIC.  See
       -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/position-independent-code
-       | gopt Opt_PIC dflags || WayDyn `elem` ways dflags ->
+       | gopt Opt_PIC dflags || WayDyn `Set.member` ways dflags ->
           ["-fPIC", "-U__PIC__", "-D__PIC__"]
       -- gcc may be configured to have PIC on by default, let's be
       -- explicit here, see #15847
@@ -5032,8 +5029,8 @@ makeDynFlagsConsistent dflags
  , not (gopt Opt_ExternalInterpreter dflags)
  , hostIsProfiled
  , isObjectTarget (hscTarget dflags)
- , WayProf `notElem` ways dflags
-    = loop dflags{ways = WayProf : ways dflags}
+ , WayProf `Set.notMember` ways dflags
+    = loop dflags{ways = Set.insert WayProf (ways dflags)}
          "Enabling -prof, because -fobject-code is enabled and GHCi is profiled"
 
  | otherwise = (dflags, [])
diff --git a/compiler/GHC/Driver/Ways.hs b/compiler/GHC/Driver/Ways.hs
index b295cc1a0d..1b9845850f 100644
--- a/compiler/GHC/Driver/Ways.hs
+++ b/compiler/GHC/Driver/Ways.hs
@@ -40,9 +40,9 @@ where
 import GhcPrelude
 import GHC.Platform
 import GHC.Driver.Flags
-import Util (nubSort)
 
 import qualified Data.Set as Set
+import Data.Set (Set)
 import Data.List (intersperse)
 import System.IO.Unsafe ( unsafeDupablePerformIO )
 
@@ -61,19 +61,18 @@ data Way
 
 
 -- | Check if a combination of ways is allowed
-allowed_combination :: [Way] -> Bool
+allowed_combination :: Set Way -> Bool
 allowed_combination ways = not disallowed
   where
-   s          = Set.fromList ways
-   disallowed = or [ Set.member s x && Set.member s y
+   disallowed = or [ Set.member ways x && Set.member ways y
                    | (x,y) <- couples
                    ]
    -- List of disallowed couples of ways
    couples = [] -- we don't have any disallowed combination of ways nowadays
 
 -- | Unique build-tag associated to a list of ways
-waysTag :: [Way] -> String
-waysTag = concat . intersperse "_" . map wayTag . nubSort
+waysTag :: Set Way -> String
+waysTag = concat . intersperse "_" . map wayTag . Set.toAscList
 
 -- | Unique build-tag associated to a way
 wayTag :: Way -> String
@@ -184,8 +183,8 @@ foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO Int
 -- | Return host "full" ways (i.e. ways that have an impact on the compilation,
 -- not RTS only ways). These ways must be used when compiling codes targeting
 -- the internal interpreter.
-hostFullWays :: [Way]
-hostFullWays = mconcat
-   [ if hostIsDynamic  then [WayDyn] else []
-   , if hostIsProfiled then [WayProf] else []
+hostFullWays :: Set Way
+hostFullWays = Set.unions
+   [ if hostIsDynamic  then Set.singleton WayDyn  else Set.empty
+   , if hostIsProfiled then Set.singleton WayProf else Set.empty
    ]
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 7e278dc07b..1eb6079c1e 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -14,6 +14,7 @@ module GHC.HsToCore.Usage (
 import GhcPrelude
 
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import GHC.Driver.Types
 import TcRnTypes
 import Name
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index c8bc4e4124..331b460c06 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -66,6 +66,7 @@ import FileCleanup
 -- Standard libraries
 import Control.Monad
 
+import qualified Data.Set as Set
 import Data.Char (isSpace)
 import Data.IORef
 import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition)
@@ -592,7 +593,7 @@ checkNonStdWay hsc_env srcspan
 
   | otherwise = return (Just (hostWayTag ++ "o"))
   where
-    targetFullWays = filter (not . wayRTSOnly) (ways (hsc_dflags hsc_env))
+    targetFullWays = Set.filter (not . wayRTSOnly) (ways (hsc_dflags hsc_env))
     hostWayTag = case waysTag hostFullWays of
                   "" -> ""
                   tag -> tag ++ "_"
@@ -949,8 +950,8 @@ dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do
                       -- Even if we're e.g. profiling, we still want
                       -- the vanilla dynamic libraries, so we set the
                       -- ways / build tag to be just WayDyn.
-                      ways = [WayDyn],
-                      buildTag = waysTag [WayDyn],
+                      ways = Set.singleton WayDyn,
+                      buildTag = waysTag (Set.singleton WayDyn),
                       outputFile = Just soFile
                   }
     -- link all "loaded packages" so symbols in those can be resolved
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index bbe889ba99..b2b13d424b 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -48,6 +48,7 @@ import Outputable
 import ErrUtils
 import GHC.Platform
 import GHC.Driver.Session
+import GHC.Driver.Ways
 
 import Control.Monad.Trans.Except (runExceptT)
 import System.FilePath
@@ -58,6 +59,7 @@ import SysTools.Info
 import SysTools.Tasks
 import SysTools.BaseDir
 import SysTools.Settings
+import qualified Data.Set as Set
 
 {-
 Note [How GHC finds toolchain utilities]
@@ -254,7 +256,7 @@ linkDynLib dflags0 o_files dep_packages
          | ( osElfTarget (platformOS (targetPlatform dflags)) ||
              osMachOTarget (platformOS (targetPlatform dflags)) ) &&
            dynLibLoader dflags == SystemDependent &&
-           WayDyn `elem` ways dflags
+           WayDyn `Set.member` ways dflags
             = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l]
               -- See Note [-Xlinker -rpath vs -Wl,-rpath]
          | otherwise = ["-L" ++ l]
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 4c546b3afc..1ad2a26e86 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -82,6 +82,7 @@ import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except (throwE, runExceptT)
 import Data.Char
 import Data.List ( isPrefixOf, partition, intercalate )
+import qualified Data.Set as Set
 import Data.Maybe
 import Prelude
 
@@ -349,12 +350,12 @@ checkOptions mode dflags srcs objs = do
    let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
    when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
 
-   when (notNull (filter wayRTSOnly (ways dflags))
+   when (not (Set.null (Set.filter wayRTSOnly (ways dflags)))
          && isInterpretiveMode mode) $
         hPutStrLn stderr ("Warning: -debug, -threaded and -ticky are ignored by GHCi")
 
         -- -prof and --interactive are not a good combination
-   when ((filter (not . wayRTSOnly) (ways dflags) /= hostFullWays)
+   when ((Set.filter (not . wayRTSOnly) (ways dflags) /= hostFullWays)
          && isInterpretiveMode mode
          && not (gopt Opt_ExternalInterpreter dflags)) $
       do throwGhcException (UsageError
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index bc10724677..64967c174d 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -39,6 +39,7 @@ Executable ghc
                    directory  >= 1   && < 1.4,
                    process    >= 1   && < 1.7,
                    filepath   >= 1   && < 1.5,
+                   containers >= 0.5 && < 0.7,
                    transformers == 0.5.*,
                    ghc-boot   == @ProjectVersionMunged@,
                    ghc        == @ProjectVersionMunged@
@@ -57,7 +58,6 @@ Executable ghc
     if flag(ghci)
         -- NB: this is never built by the bootstrapping GHC+libraries
         Build-depends:
-            containers     >= 0.5 && < 0.7,
             deepseq        == 1.4.*,
             ghc-prim       >= 0.5.0 && < 0.7,
             ghci           == @ProjectVersionMunged@,