Use a Set to represent Ways

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

Metric Increase:
    hie002

4 files changed, 34 insertions, 35 deletions

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
    ]