DynFlags: don't store buildTag

`DynFlags.buildTag` was a field created from the set of Ways in
`DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which
was fragile. We want to avoid global state like this (#17957).

Moreover in #14335 we also want to support loading units with different
ways: target units would still use `DynFlags.ways` but plugins would use
`GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build
tag and with ways, we recompute the buildTag on-the-fly (should be
pretty cheap) and we remove `DynFlags.buildTag` field.

9 files changed, 40 insertions, 43 deletions

diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index f6f0814739..a1b2f9aff0 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -42,6 +42,7 @@ import GHC.Data.FastString
 import GHC.Utils.Misc
 import GHC.Builtin.Names ( gHC_PRIM )
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import GHC.Utils.Outputable as Outputable
 import GHC.Data.Maybe    ( expectJust )
 
@@ -368,7 +369,7 @@ findPackageModule_ hsc_env mod pkg_conf =
 
   let
      dflags = hsc_dflags hsc_env
-     tag = buildTag dflags
+     tag = waysBuildTag (ways dflags)
 
            -- hi-suffix for packages depends on the build tag.
      package_hisuf | null tag  = "hi"
@@ -700,7 +701,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
 
             _ -> panic "cantFindErr"
 
-    build_tag = buildTag dflags
+    build_tag = waysBuildTag (ways dflags)
 
     not_found_in_package pkg files
        | build_tag /= ""
@@ -809,7 +810,7 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
 
             _ -> panic "cantFindInstalledErr"
 
-    build_tag = buildTag dflags
+    build_tag = waysBuildTag (ways dflags)
     pkgstate = unitState dflags
 
     looks_like_srcpkgid :: UnitId -> SDoc
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 78d030b6dd..ed963ec733 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -20,7 +20,6 @@ import GHC.Prelude
 import qualified GHC
 import GHC.Driver.Monad
 import GHC.Driver.Session
-import GHC.Driver.Ways
 import GHC.Utils.Misc
 import GHC.Driver.Types
 import qualified GHC.SysTools as SysTools
@@ -65,7 +64,6 @@ doMkDependHS srcs = do
     -- be specified.
     let dflags = dflags0 {
                      ways = Set.empty,
-                     buildTag = waysTag Set.empty,
                      hiSuf = "hi",
                      objectSuf = "o"
                  }
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 2ffcf250b7..a439dbe9aa 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -64,7 +64,7 @@ module GHC.Driver.Session (
         optimisationFlags,
         setFlagsFromEnvFile,
 
-        addWay', updateWays,
+        addWay',
 
         homeUnit, mkHomeModule, isHomeModule,
 
@@ -526,7 +526,6 @@ data DynFlags = DynFlags {
 
   -- ways
   ways                  :: Set Way,     -- ^ Way flags from the command line
-  buildTag              :: String,      -- ^ The global \"way\" (e.g. \"p\" for prof)
 
   -- For object splitting
   splitInfo             :: Maybe (String,Int),
@@ -1208,9 +1207,8 @@ dynamicTooMkDynamicDynFlags dflags0
                         hiSuf = dynHiSuf dflags1,
                         objectSuf = dynObjectSuf dflags1
                     }
-          dflags3 = updateWays dflags2
-          dflags4 = gopt_unset dflags3 Opt_BuildDynamicToo
-      in dflags4
+          dflags3 = gopt_unset dflags2 Opt_BuildDynamicToo
+      in dflags3
 
 -- | Compute the path of the dynamic object corresponding to an object file.
 dynamicOutputFile :: DynFlags -> FilePath -> FilePath
@@ -1367,7 +1365,6 @@ defaultDynFlags mySettings llvmConfig =
         unitDatabases           = Nothing,
         unitState               = emptyUnitState,
         ways                    = defaultWays mySettings,
-        buildTag                = waysTag (defaultWays mySettings),
         splitInfo               = Nothing,
 
         ghcNameVersion = sGhcNameVersion mySettings,
@@ -2127,47 +2124,40 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
 
   -- check for disabled flags in safe haskell
   let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
-      dflags3 = updateWays dflags2
-      theWays = ways dflags3
+      theWays = ways dflags2
 
   unless (allowed_combination theWays) $ liftIO $
       throwGhcExceptionIO (CmdLineError ("combination not supported: " ++
                                intercalate "/" (map wayDesc (Set.toAscList theWays))))
 
   let chooseOutput
-        | isJust (outputFile dflags3)          -- Only iff user specified -o ...
-        , not (isJust (dynOutputFile dflags3)) -- but not -dyno
-        = return $ dflags3 { dynOutputFile = Just $ dynamicOutputFile dflags3 outFile }
+        | isJust (outputFile dflags2)          -- Only iff user specified -o ...
+        , not (isJust (dynOutputFile dflags2)) -- but not -dyno
+        = return $ dflags2 { dynOutputFile = Just $ dynamicOutputFile dflags2 outFile }
         | otherwise
-        = return dflags3
+        = return dflags2
         where
-          outFile = fromJust $ outputFile dflags3
-  dflags4 <- ifGeneratingDynamicToo dflags3 chooseOutput (return dflags3)
+          outFile = fromJust $ outputFile dflags2
+  dflags3 <- ifGeneratingDynamicToo dflags2 chooseOutput (return dflags2)
 
-  let (dflags5, consistency_warnings) = makeDynFlagsConsistent dflags4
+  let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
 
   -- Set timer stats & heap size
-  when (enableTimeStats dflags5) $ liftIO enableTimingStats
-  case (ghcHeapSize dflags5) of
+  when (enableTimeStats dflags4) $ liftIO enableTimingStats
+  case (ghcHeapSize dflags4) of
     Just x -> liftIO (setHeapSize x)
     _      -> return ()
 
-  liftIO $ setUnsafeGlobalDynFlags dflags5
+  liftIO $ setUnsafeGlobalDynFlags dflags4
 
   let warns' = map (Warn Cmd.NoReason) (consistency_warnings ++ sh_warns)
 
-  return (dflags5, leftover, warns' ++ warns)
+  return (dflags4, leftover, warns' ++ warns)
 
 -- | Write an error or warning to the 'LogOutput'.
 putLogMsg :: DynFlags -> WarnReason -> Severity -> SrcSpan -> MsgDoc -> IO ()
 putLogMsg dflags = log_action dflags dflags
 
-updateWays :: DynFlags -> DynFlags
-updateWays dflags
-    = dflags {
-        buildTag = waysTag (Set.filter (not . wayRTSOnly) (ways dflags))
-      }
-
 -- | Check (and potentially disable) any extensions that aren't allowed
 -- in safe mode.
 --
diff --git a/compiler/GHC/Driver/Ways.hs b/compiler/GHC/Driver/Ways.hs
index eae86864d4..c33cf24702 100644
--- a/compiler/GHC/Driver/Ways.hs
+++ b/compiler/GHC/Driver/Ways.hs
@@ -30,6 +30,7 @@ module GHC.Driver.Ways
    , wayRTSOnly
    , wayTag
    , waysTag
+   , waysBuildTag
    -- * Host GHC ways
    , hostFullWays
    , hostIsProfiled
@@ -70,10 +71,17 @@ allowed_combination ways = not disallowed
    -- 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
+-- | Unique tag associated to a list of ways
 waysTag :: Set Way -> String
 waysTag = concat . intersperse "_" . map wayTag . Set.toAscList
 
+-- | Unique build-tag associated to a list of ways
+--
+-- RTS only ways are filtered out because they have no impact on the build.
+waysBuildTag :: Set Way -> String
+waysBuildTag ws = waysTag (Set.filter (not . wayRTSOnly) ws)
+
+
 -- | Unique build-tag associated to a way
 wayTag :: Way -> String
 wayTag (WayCustom xs) = xs
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 567c84625e..0d9d8aabd6 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -186,7 +186,7 @@ mkPluginUsage hsc_env pluginModule
             if useDyn
               then libLocs
               else
-                let dflags'  = updateWays (addWay' WayDyn dflags)
+                let dflags'  = addWay' WayDyn dflags
                     dlibLocs = [ searchPath </> mkHsSOName platform dlibLoc
                                | searchPath <- searchPaths
                                , dlibLoc    <- packageHsLibs dflags' pkg
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 4c676c4d11..d92aa742af 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -43,6 +43,7 @@ import GHC.Driver.Types
 import GHC.Unit
 import GHC.Types.Name
 import GHC.Driver.Session
+import GHC.Driver.Ways
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
 import GHC.Utils.Panic
@@ -58,6 +59,7 @@ import GHC.Data.FastString
 import GHC.Settings.Constants
 import GHC.Utils.Misc
 
+import Data.Set (Set)
 import Data.Array
 import Data.Array.ST
 import Data.Array.Unsafe
@@ -136,7 +138,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
     errorOnMismatch "mismatched interface file versions" our_ver check_ver
 
     check_way <- get bh
-    let way_descr = getWayDescr dflags
+    let way_descr = getWayDescr platform (ways dflags)
     wantedGot "Way" way_descr check_way ppr
     when (checkHiWay == CheckHiWay) $
         errorOnMismatch "mismatched interface file ways" way_descr check_way
@@ -191,7 +193,7 @@ writeBinIface dflags hi_path mod_iface = do
 
     -- The version and way descriptor go next
     put_ bh (show hiVersion)
-    let way_descr = getWayDescr dflags
+    let way_descr = getWayDescr platform (ways dflags)
     put_  bh way_descr
 
     extFields_p_p <- tellBin bh
@@ -428,10 +430,10 @@ data BinDictionary = BinDictionary {
                                 -- indexed by FastString
   }
 
-getWayDescr :: DynFlags -> String
-getWayDescr dflags
-  | platformUnregisterised (targetPlatform dflags) = 'u':tag
-  | otherwise                                      =     tag
-  where tag = buildTag dflags
+getWayDescr :: Platform -> Set Way -> String
+getWayDescr platform ws
+  | platformUnregisterised platform = 'u':tag
+  | otherwise                       =     tag
+  where tag = waysBuildTag ws
         -- if this is an unregisterised build, make sure our interfaces
         -- can't be used by a registerised build.
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 68dadc53a4..f94d225889 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -954,7 +954,6 @@ dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do
                       -- the vanilla dynamic libraries, so we set the
                       -- ways / build tag to be just 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/GHC/SysTools.hs b/compiler/GHC/SysTools.hs
index 24a3fefca9..ab83b3bf2a 100644
--- a/compiler/GHC/SysTools.hs
+++ b/compiler/GHC/SysTools.hs
@@ -239,10 +239,9 @@ linkDynLib dflags0 o_files dep_packages
         dflags1 = if platformMisc_ghcThreaded $ platformMisc dflags0
           then addWay' WayThreaded dflags0
           else                     dflags0
-        dflags2 = if platformMisc_ghcDebugged $ platformMisc dflags1
+        dflags = if platformMisc_ghcDebugged $ platformMisc dflags1
           then addWay' WayDebug dflags1
           else                  dflags1
-        dflags = updateWays dflags2
 
         verbFlags = getVerbFlags dflags
         o_file = outputFile dflags
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 14e2b8048c..541c07bdfa 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -198,7 +198,7 @@ main' postLoadMode dflags0 args flagWarnings = do
   let dflags4 = case lang of
                 HscInterpreted | not (gopt Opt_ExternalInterpreter dflags3) ->
                     let platform = targetPlatform dflags3
-                        dflags3a = updateWays $ dflags3 { ways = hostFullWays }
+                        dflags3a = dflags3 { ways = hostFullWays }
                         dflags3b = foldl gopt_set dflags3a
                                  $ concatMap (wayGeneralFlags platform)
                                              hostFullWays