Teo Camarasu pushed to branch wip/T25282 at Glasgow Haskell Compiler / GHC Commits: 6d791567 by Teo Camarasu at 2025-06-20T17:43:18+01:00 Expose ghc-internal unit id through the settings file This in combination with the unit id of the compiler library allows cabal to know of the two unit ids that should not be reinstalled (in specific circumstances) as: - when using plugins, we want to link against exactly the compiler unit id - when using TemplateHaskell we want to link against exactly the package that contains the TemplateHaskell interfaces, which is `ghc-internal` See: https://github.com/haskell/cabal/issues/10087 Resolves #25282 - - - - - ae14bd72 by Teo Camarasu at 2025-06-20T17:43:35+01:00 linters: lint-whitespace: bump upper-bound for containers - - - - - 4 changed files: - compiler/GHC/Driver/Session.hs - compiler/Setup.hs - hadrian/src/Rules/Generate.hs - linters/lint-whitespace/lint-whitespace.cabal Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3460,6 +3460,7 @@ compilerInfo dflags ("Project Patch Level1", cProjectPatchLevel1), ("Project Patch Level2", cProjectPatchLevel2), ("Project Unit Id", cProjectUnitId), + ("ghc-internal Unit Id", cGhcInternalUnitId), -- See Note [Special unit-ids] ("Booter version", cBooterVersion), ("Stage", cStage), ("Build platform", cBuildPlatformString), @@ -3513,6 +3514,23 @@ compilerInfo dflags expandDirectories :: FilePath -> Maybe FilePath -> String -> String expandDirectories topd mtoold = expandToolDir useInplaceMinGW mtoold . expandTopDir topd +-- Note [Special unit-ids] +-- ~~~~~~~~~~~~~~~~~~~~~~~ +-- Certain units are special to the compiler: +-- - Wired-in identifiers reference a specific unit-id of `ghc-internal`. +-- - GHC plugins must be linked against a specific unit-id of `ghc`, +-- namely the same one as the compiler. +-- - When using Template Haskell, splices refer to the Template Haskell +-- interface defined in `ghc-internal`, and must be linked against the same +-- unit-id as the compiler. +-- +-- We therefore expose the unit-id of `ghc-internal` ("ghc-internal Unit Id") and +-- ghc ("Project Unit Id") through `ghc --info`. +-- +-- This allows build tools to act accordingly, eg, if a user wishes to build a +-- GHC plugin, `cabal-install` might force them to use the exact `ghc` unit +-- that the compiler was linked against. + {- ----------------------------------------------------------------------------- Note [DynFlags consistency] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/Setup.hs ===================================== @@ -11,6 +11,7 @@ import Distribution.Verbosity import Distribution.Simple.Program import Distribution.Simple.Utils import Distribution.Simple.Setup +import Distribution.Simple.PackageIndex import System.IO import System.Process @@ -22,6 +23,7 @@ import qualified Data.Map as Map import GHC.ResponseFile import System.Environment + main :: IO () main = defaultMainWithHooks ghcHooks where @@ -56,7 +58,7 @@ primopIncls = ] ghcAutogen :: Verbosity -> LocalBuildInfo -> IO () -ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap} +ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameMap,installedPkgs} = do -- Get compiler/ root directory from the cabal file let Just compilerRoot = takeDirectory <$> pkgDescrFile @@ -96,9 +98,14 @@ ghcAutogen verbosity lbi@LocalBuildInfo{pkgDescrFile,withPrograms,componentNameM Just [LibComponentLocalBuildInfo{componentUnitId}] -> unUnitId componentUnitId _ -> error "Couldn't find unique cabal library when building ghc" + let cGhcInternalUnitId = case lookupPackageName installedPkgs (mkPackageName "ghc-internal") of + -- We assume there is exactly one copy of `ghc-internal` in our dependency closure + [(_,[packageInfo])] -> unUnitId $ installedUnitId packageInfo + _ -> error "Couldn't find unique ghc-internal library when building ghc" + -- Write GHC.Settings.Config configHsPath = autogenPackageModulesDir lbi "GHC/Settings/Config.hs" - configHs = generateConfigHs cProjectUnitId settings + configHs = generateConfigHs cProjectUnitId cGhcInternalUnitId settings createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath) rewriteFileEx verbosity configHsPath configHs @@ -110,8 +117,9 @@ getSetting settings kh kr = go settings kr Just v -> Right v generateConfigHs :: String -- ^ ghc's cabal-generated unit-id, which matches its package-id/key + -> String -- ^ ghc-internal's cabal-generated unit-id, which matches its package-id/key -> [(String,String)] -> String -generateConfigHs cProjectUnitId settings = either error id $ do +generateConfigHs cProjectUnitId cGhcInternalUnitId settings = either error id $ do let getSetting' = getSetting $ (("cStage","2"):) settings buildPlatform <- getSetting' "cBuildPlatformString" "Host platform" hostPlatform <- getSetting' "cHostPlatformString" "Target platform" @@ -127,6 +135,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -150,4 +159,7 @@ generateConfigHs cProjectUnitId settings = either error id $ do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -601,6 +601,8 @@ generateConfigHs = do -- 'pkgUnitId' on 'compiler' (the ghc-library package) to create the -- unit-id in both situations. cProjectUnitId <- expr . (`pkgUnitId` compiler) =<< getStage + + cGhcInternalUnitId <- expr . (`pkgUnitId` ghcInternal) =<< getStage return $ unlines [ "module GHC.Settings.Config" , " ( module GHC.Version" @@ -610,6 +612,7 @@ generateConfigHs = do , " , cBooterVersion" , " , cStage" , " , cProjectUnitId" + , " , cGhcInternalUnitId" , " ) where" , "" , "import GHC.Prelude.Basic" @@ -633,6 +636,9 @@ generateConfigHs = do , "" , "cProjectUnitId :: String" , "cProjectUnitId = " ++ show cProjectUnitId + , "" + , "cGhcInternalUnitId :: String" + , "cGhcInternalUnitId = " ++ show cGhcInternalUnitId ] where stageString (Stage0 InTreeLibs) = "1" ===================================== linters/lint-whitespace/lint-whitespace.cabal ===================================== @@ -24,7 +24,7 @@ executable lint-whitespace process ^>= 1.6, containers - >= 0.6 && <0.8, + >= 0.6 && <0.9, base >= 4.14 && < 5, text View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44c4682da95e578d0024f1728517f53... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44c4682da95e578d0024f1728517f53... You're receiving this email because of your account on gitlab.haskell.org.