Sven Tennie pushed to branch wip/supersven/libDir-setting at Glasgow Haskell Compiler / GHC Commits: e00627ea by Sven Tennie at 2026-05-05T14:20:35+02:00 Add optional config setting for LibDir (#19174) Previously, the `libDir` was derived from `topDir`. This won't work for inplace stage2 cross-compilers where binaries and libraries are in different stage dirs (`_build/stage1/` for executables and `_build/stage2` for libraries). `LibDir`` is set in the inplace `settings` files. For bindists, we generate a new `settings` file with no `LibDir` entry. GHC then defaults to use `topDir` as `libDir` again. This keeps the bindist relocatable. If `LibDir` is a relative path, it is interpreted relatively to `topDir`. - - - - - 8 changed files: - + changelog.d/libdir-setting - compiler/GHC/Driver/Config/Interpreter.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs Changes: ===================================== changelog.d/libdir-setting ===================================== @@ -0,0 +1,15 @@ +section: packaging +synopsis: Added a new optional configuration setting for `LibDir` to support inplace + stage2 cross-compilers where binaries and libraries are in different stage + directories. +issues: #19174 +mrs: !15716 + +description: { + Previously, the `libDir` was always derived from `topDir`, which won't work + for inplace stage2 cross-compilers where executables are in `_build/stage1/` + and libraries are in `_build/stage2/`. Now, `LibDir` can be set, but is by + default derived from `topDir`. This facilitates the mentioned behaviour + while keeping the binary distribution code relocatable. This is a refactoring + step that does not change actual behaviour. +} ===================================== compiler/GHC/Driver/Config/Interpreter.hs ===================================== @@ -17,8 +17,8 @@ import System.Directory initInterpOpts :: DynFlags -> IO InterpOpts initInterpOpts dflags = do - wasm_dyld <- makeAbsolute $ topDir dflags "dyld.mjs" - js_interp <- makeAbsolute $ topDir dflags "ghc-interp.js" + wasm_dyld <- makeAbsolute $ libDir dflags "dyld.mjs" + js_interp <- makeAbsolute $ libDir dflags "ghc-interp.js" pure $ InterpOpts { interpExternal = gopt Opt_ExternalInterpreter dflags , interpProg = pgm_i dflags ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -60,7 +60,7 @@ module GHC.Driver.DynFlags ( -- ** System tool settings and locations programName, projectVersion, - ghcUsagePath, ghciUsagePath, topDir, toolDir, + ghcUsagePath, ghciUsagePath, topDir, libDir, toolDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, @@ -1508,6 +1508,8 @@ ghciUsagePath :: DynFlags -> FilePath ghciUsagePath dflags = fileSettings_ghciUsagePath $ fileSettings dflags topDir :: DynFlags -> FilePath topDir dflags = fileSettings_topDir $ fileSettings dflags +libDir :: DynFlags -> FilePath +libDir dflags = fileSettings_libDir $ fileSettings dflags toolDir :: DynFlags -> Maybe FilePath toolDir dflags = fileSettings_toolDir $ fileSettings dflags extraGccViaCFlags :: DynFlags -> [String] ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3548,9 +3548,9 @@ compilerInfo dflags ("Project name", cProjectName) -- Next come the settings, so anything else can be overridden -- in the settings file (as "lookup" uses the first match for the - -- key) + -- key). We filter out LibDir from rawSettings to avoid duplication. : map (fmap expandDirectories) - (rawSettings dflags) + (filter ((/= "LibDir") . fst) (rawSettings dflags)) ++ [("C compiler command", queryCmd $ ccProgram . tgtCCompiler), ("C compiler flags", queryFlags $ ccProgram . tgtCCompiler), @@ -3651,7 +3651,7 @@ compilerInfo dflags -- Whether or not GHC was compiled using -prof ("GHC Profiled", showBool hostIsProfiled), ("Debug on", showBool debugIsOn), - ("LibDir", topDir dflags), + ("LibDir", libDir dflags), -- This is always an absolute path, unlike "Relative Global Package DB" which is -- in the settings file. ("Global Package DB", globalPackageDatabasePath dflags) ===================================== compiler/GHC/Settings.hs ===================================== @@ -184,6 +184,7 @@ data FileSettings = FileSettings , fileSettings_toolDir :: Maybe FilePath -- ditto , fileSettings_topDir :: FilePath -- ditto , fileSettings_globalPackageDatabase :: FilePath + , fileSettings_libDir :: FilePath } ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -28,6 +28,7 @@ import GHC.Toolchain.Program import GHC.Toolchain import GHC.Data.Maybe import Data.Bifunctor (Bifunctor(second)) +import Data.Either (fromRight) data SettingsError = SettingsError_MissingData String @@ -148,6 +149,17 @@ initSettings top_dir = do baseUnitId <- getSetting_raw "base unit-id" + -- LibDir is optional. If not set, derive it from topDir. This allows + -- bindists to work without explicitly setting LibDir, but gives us the + -- option to override it for inplace test compilers (the "stage2 + -- cross-compiler" scenario). If LibDir is a relative path, it is + -- interpreted relative to topDir. + let lib_dir_raw = fromRight top_dir $ + getRawFilePathSetting top_dir settingsFile mySettings "LibDir" + lib_dir = if isRelative lib_dir_raw + then top_dir lib_dir_raw + else lib_dir_raw + return $ Settings { sGhcNameVersion = GhcNameVersion { ghcNameVersion_programName = "ghc" @@ -159,6 +171,7 @@ initSettings top_dir = do , fileSettings_ghciUsagePath = ghci_usage_msg_path , fileSettings_toolDir = mtool_dir , fileSettings_topDir = top_dir + , fileSettings_libDir = lib_dir , fileSettings_globalPackageDatabase = globalpkgdb_path } ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -14,6 +14,7 @@ import qualified System.Directory.Extra as IO import Data.Either import qualified Data.Set as Set import Oracles.Flavour +import Rules.Generate (generateSettings) {- Note [Binary distributions] @@ -218,6 +219,16 @@ bindistRules = do IO.createFileLink version_prog versioned_runhaskell_path copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir + + -- Regenerate settings file without LibDir. For bindists, LibDir should + -- be derived from topdir at runtime such that the GHC binary is + -- relocatable. + let bindistSettings = bindistFilesDir -/- "lib" -/- "settings" + bindistContext = vanillaContext Stage1 compiler + bindistSettingsContent <- interpretInContext bindistContext $ + generateSettings bindistSettings False (bindistFilesDir -/- "lib" -/- "package.conf.d") + writeFile' bindistSettings bindistSettingsContent + copyDirectory (rtsIncludeDir) bindistFilesDir when windowsHost $ createGhcii (bindistFilesDir -/- "bin") ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -1,7 +1,7 @@ module Rules.Generate ( isGeneratedCmmFile, compilerDependencies, generatePackageCode, generateRules, copyRules, generatedDependencies, - templateRules + templateRules, generateSettings ) where import Development.Shake.FilePath @@ -256,8 +256,17 @@ generateRules = do forM_ allStages $ \stage -> do let prefix = root -/- stageString stage -/- "lib" - go gen file = generate file (semiEmptyTarget (succStage stage)) gen - (prefix -/- "settings") %> \out -> go (generateSettings out) out + -- Stage0 compiler builds Stage1, Stage1 -> Stage2, etc. + buildStage = succStage stage + go gen file = generate file (semiEmptyTarget buildStage) gen + (prefix -/- "settings") %> \out -> do + let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final) + pkgDb <- case buildStage of + Stage0 {} -> error "Unable to generate settings for stage0. This should never be reached." + Stage1 -> get_pkg_db Stage1 + Stage2 -> get_pkg_db Stage1 + Stage3 -> get_pkg_db Stage2 + go (generateSettings out True pkgDb) out (prefix -/- "targets" -/- "default.target") %> \out -> go (show <$> expr getTargetTarget) out where @@ -459,19 +468,16 @@ ghcWrapper stage = do return $ unwords $ map show $ [ ghcPath ] ++ [ "$@" ] -generateSettings :: FilePath -> Expr String -generateSettings settingsFile = do +-- | Generate settings file, optionally including @LibDir@. +-- +-- @pkgDb@: absolute path to the package DB for the @"Relative Global Package +-- DB"@ setting. Callers determine the correct path (in-tree or bindist). For +-- bindists, we omit @LibDir@ so it defaults to @topDir@ at runtime. +generateSettings :: FilePath -> Bool -> FilePath -> Expr String +generateSettings settingsFile includeLibDir package_db_path = do ctx <- getContext stage <- getStage - package_db_path <- expr $ do - let get_pkg_db stg = packageDbPath (PackageDbLoc stg Final) - case stage of - Stage0 {} -> error "Unable to generate settings for stage0" - Stage1 -> get_pkg_db Stage1 - Stage2 -> get_pkg_db Stage1 - Stage3 -> get_pkg_db Stage2 - -- The unit-id of the base package which is always linked against (#25382) base_unit_id <- expr $ do case stage of @@ -481,14 +487,22 @@ generateSettings settingsFile = do Stage3 -> pkgUnitId Stage2 base let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path + -- E.g. the Stage2 compiler lives in _build/stage1 + -- So, we need to decrement the stage to get the correct directory + stage_dir_stage = predStage stage + + lib_topDir :: FilePath <- expr $ stageLibPath stage_dir_stage + let rel_lib_topDir = makeRelativeNoSysLink (dropFileName settingsFile) lib_topDir settings <- traverse sequence $ - [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) - , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) - , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) - , ("Relative Global Package DB", pure rel_pkg_db) - , ("base unit-id", pure base_unit_id) - ] + [ ("unlit command", ("$topdir/../bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) + , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter (predStage stage)) + , ("RTS ways", escapeArgs . map show . Set.toList <$> getRtsWays) + , ("Relative Global Package DB", pure rel_pkg_db) + , ("base unit-id", pure base_unit_id) + ] + ++ ([("LibDir", pure rel_lib_topDir) | includeLibDir]) + let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")" pure $ case settings of [] -> "[]" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e00627ea30555e63d7fd25dc20b45ced... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e00627ea30555e63d7fd25dc20b45ced... You're receiving this email because of your account on gitlab.haskell.org.