Hardwire a better unit-id for ghc

Previously, the unit-id of ghc-the-library was fixed as `ghc`.
This was done primarily because the compiler must know the unit-id of
some packages (including ghc) a-priori to define wired-in names.

However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed
to `ghc` might result in subtle bugs when different ghc's interact.

A good example of this is having GHC_A load a plugin compiled by GHC_B,
where GHC_A and GHC_B are linked to ghc-libraries that are ABI
incompatible. Without a distinction between the unit-id of the ghc library
GHC_A is linked against and the ghc library the plugin it is loading was
compiled against, we can't check compatibility.

This patch gives a slightly better unit-id to ghc (ghc-version) by
(1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0)
(2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id.
    (2.1) `GHC.Settings.Config` is generated by Hadrian
    (2.2) and also by cabal through `compiler/Setup.hs`
This unit-id definition is imported by `GHC.Unit.Types` and used to
set the wired-in unit-id of "ghc", which was previously fixed to "ghc"

The commits following this one will improve the unit-id with a
cabal-style package hash and check compatibility when loading plugins.

Note that we also ensure that ghc's unit key matches unit id both when
hadrian or cabal builds ghc, and in this way we no longer need to add
`ghc` to the WiringMap.

4 files changed, 73 insertions, 10 deletions

diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index da5cf29506..027b97d226 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -4822,6 +4822,7 @@ compilerInfo dflags
        ("Project Patch Level",         cProjectPatchLevel),
        ("Project Patch Level1",        cProjectPatchLevel1),
        ("Project Patch Level2",        cProjectPatchLevel2),
+       ("Project Unit Id",             cProjectUnitId),
        ("Booter version",              cBooterVersion),
        ("Stage",                       cStage),
        ("Build platform",              cBuildPlatformString),
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index 7439ab7dde..48db9bcdde 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -99,6 +99,7 @@ import GHC.Data.FastString
 import GHC.Utils.Encoding
 import GHC.Utils.Fingerprint
 import GHC.Utils.Misc
+import GHC.Settings.Config (cProjectUnitId)
 
 import Control.DeepSeq
 import Data.Data
@@ -597,7 +598,7 @@ primUnitId        = UnitId (fsLit "ghc-prim")
 bignumUnitId      = UnitId (fsLit "ghc-bignum")
 baseUnitId        = UnitId (fsLit "base")
 rtsUnitId         = UnitId (fsLit "rts")
-thisGhcUnitId     = UnitId (fsLit "ghc")
+thisGhcUnitId     = UnitId (fsLit cProjectUnitId) -- See Note [GHC's Unit Id]
 interactiveUnitId = UnitId (fsLit "interactive")
 thUnitId          = UnitId (fsLit "template-haskell")
 
@@ -625,8 +626,49 @@ wiredInUnitIds =
    , baseUnitId
    , rtsUnitId
    , thUnitId
-   , thisGhcUnitId
    ]
+   -- NB: ghc is no longer part of the wired-in units since its unit-id, given
+   -- by hadrian or cabal, is no longer overwritten and now matches both the
+   -- cProjectUnitId defined in build-time-generated module GHC.Version, and
+   -- the unit key.
+   --
+   -- See also Note [About units], taking into consideration ghc is still a
+   -- wired-in unit but whose unit-id no longer needs special handling because
+   -- we take care that it matches the unit key.
+
+{-
+Note [GHC's Unit Id]
+~~~~~~~~~~~~~~~~~~~~
+Previously, the unit-id of ghc-the-library was fixed as `ghc`.
+This was done primarily because the compiler must know the unit-id of
+some packages (including ghc) a-priori to define wired-in names.
+
+However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed
+to `ghc` might result in subtle bugs when different ghc's interact.
+
+A good example of this is having GHC_A load a plugin compiled by GHC_B,
+where GHC_A and GHC_B are linked to ghc-libraries that are ABI
+incompatible. Without a distinction between the unit-id of the ghc library
+GHC_A is linked against and the ghc library the plugin it is loading was
+compiled against, we can't check compatibility.
+
+Now, we give a better unit-id to ghc (`ghc-version-hash`) by
+
+(1) Not setting -this-unit-id fixed to `ghc` in `ghc.cabal`, but rather by having
+    (1.1) Hadrian pass the new unit-id with -this-unit-id for stage0-1
+    (1.2) Cabal pass the unit-id it computes to ghc, which it already does by default
+
+(2) Adding a definition to `GHC.Settings.Config` whose value is the new
+unit-id. This is crucial to define the wired-in name of the GHC unit
+(`thisGhcUnitId`) which *must* match the value of the -this-unit-id flag.
+(Where `GHC.Settings.Config` is a module generated by the build system which,
+be it either hadrian or cabal, knows exactly the unit-id it passed with -this-unit-id)
+
+Note that we also ensure the ghc's unit key matches its unit id, both when
+hadrian or cabal is building ghc. This way, we no longer need to add `ghc` to
+the WiringMap, and that's why 'wiredInUnitIds' no longer includes
+'thisGhcUnitId'.
+-}
 
 ---------------------------------------------------------------------
 -- Boot Modules
diff --git a/compiler/Setup.hs b/compiler/Setup.hs
index 97662a7775..f3f7d522d2 100644
--- a/compiler/Setup.hs
+++ b/compiler/Setup.hs
@@ -3,7 +3,10 @@ module Main where
 
 import Distribution.Simple
 import Distribution.Simple.BuildPaths
+import Distribution.Types.ComponentLocalBuildInfo
+import Distribution.Types.ComponentName (ComponentName(CLibName))
 import Distribution.Types.LocalBuildInfo
+import Distribution.Types.LibraryName (LibraryName(LMainLibName))
 import Distribution.Verbosity
 import Distribution.Simple.Program
 import Distribution.Simple.Utils
@@ -15,6 +18,7 @@ import System.Directory
 import System.FilePath
 import Control.Monad
 import Data.Char
+import qualified Data.Map as Map
 import GHC.ResponseFile
 import System.Environment
 
@@ -85,9 +89,13 @@ ghcAutogen verbosity lbi@LocalBuildInfo{..} = do
     callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS]
     renameFile tmp platformConstantsPath
 
+  let cProjectUnitId = case Map.lookup (CLibName LMainLibName) componentNameMap of
+                         Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId
+                         _ -> error "Couldn't find unique cabal library when building ghc"
+
   -- Write GHC.Settings.Config
-  let configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
-      configHs = generateConfigHs settings
+      configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
+      configHs = generateConfigHs cProjectUnitId settings
   createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
   rewriteFileEx verbosity configHsPath configHs
 
@@ -98,8 +106,9 @@ getSetting settings kh kr = go settings kr
       Nothing -> Left (show k ++ " not found in settings: " ++ show settings)
       Just v -> Right v
 
-generateConfigHs :: [(String,String)] -> String
-generateConfigHs settings = either error id $ do
+generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key
+                 -> [(String,String)] -> String
+generateConfigHs cProjectUnitId settings = either error id $ do
     let getSetting' = getSetting $ (("cStage","2"):) settings
     buildPlatform  <- getSetting' "cBuildPlatformString" "Host platform"
     hostPlatform   <- getSetting' "cHostPlatformString" "Target platform"
@@ -114,6 +123,7 @@ generateConfigHs settings = either error id $ do
         , "  , cProjectName"
         , "  , cBooterVersion"
         , "  , cStage"
+        , "  , cProjectUnitId"
         , "  ) where"
         , ""
         , "import GHC.Prelude.Basic"
@@ -134,4 +144,7 @@ generateConfigHs settings = either error id $ do
         , ""
         , "cStage                :: String"
         , "cStage                = show ("++ cStage ++ " :: Int)"
+        , ""
+        , "cProjectUnitId :: String"
+        , "cProjectUnitId = " ++ show cProjectUnitId
         ]
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 4194dd7b05..a0a5f23133 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -39,7 +39,7 @@ extra-source-files:
 
 
 custom-setup
-    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath
+    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.10, directory, process, filepath, containers
 
 Flag internal-interpreter
     Description: Build with internal interpreter support.
@@ -57,6 +57,12 @@ Flag build-tool-depends
     Description: Use build-tool-depends
     Default: True
 
+-- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc`
+Flag hadrian-stage0
+    Description: Enable if compiling the stage0 compiler with hadrian
+    Default: False
+    Manual: True
+
 Library
     Default-Language: Haskell2010
     Exposed: False
@@ -137,9 +143,10 @@ Library
 
     Include-Dirs: .
 
-    -- We need to set the unit id to ghc (without a version number)
-    -- as it's magic.
-    GHC-Options: -this-unit-id ghc
+    if flag(hadrian-stage0)
+        -- We need to set the unit id to ghc (without a version number)
+        -- as it's magic.
+        GHC-Options: -this-unit-id ghc
 
     c-sources:
         cbits/cutils.c