Sven Tennie pushed to branch wip/supersven/libDir-setting at Glasgow Haskell Compiler / GHC Commits: 00a2dffe by Sven Tennie at 2026-05-09T18:59:30+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`. - - - - - 123cf13d by Sven Tennie at 2026-05-09T18:59:30+02:00 WIP - package db relative to libDir - - - - - a9eb8a3a by Sven Tennie at 2026-05-09T18:59:30+02:00 Add comments to FileSettings - - - - - 071ff83d by Sven Tennie at 2026-05-09T18:59:30+02:00 WIP - Use optional LibDir for global package db path in ghc-boot - - - - - e5113d6c by Sven Tennie at 2026-05-09T18:59:30+02:00 WIP - LibDir test - - - - - 12 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 - libraries/ghc-boot/GHC/Settings/Utils.hs - + testsuite/tests/ghc-api/settings-escape/T19174.hs - + testsuite/tests/ghc-api/settings-escape/T19174.stdout - testsuite/tests/ghc-api/settings-escape/all.T 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 ===================================== @@ -179,11 +179,24 @@ data ToolSettings = ToolSettings -- | Paths to various files and directories used by GHC, including those that -- provide more settings. data FileSettings = FileSettings - { fileSettings_ghcUsagePath :: FilePath -- ditto - , fileSettings_ghciUsagePath :: FilePath -- ditto - , fileSettings_toolDir :: Maybe FilePath -- ditto - , fileSettings_topDir :: FilePath -- ditto + { fileSettings_ghcUsagePath :: FilePath + -- ^ Path to @ghc-usage.txt@, displayed by @ghc --help@ + , fileSettings_ghciUsagePath :: FilePath + -- ^ Path to @ghci-usage.txt@, displayed by @ghci --help@ + , fileSettings_toolDir :: Maybe FilePath + -- ^ Directory containing the mingw toolchain (Windows only); + -- see Note [tooldir: How GHC finds mingw on Windows] in `GHC.SysTools.BaseDir` + , fileSettings_topDir :: FilePath + -- ^ GHC's top directory: the root from which GHC locates its support files + -- (e.g. settings). + -- See Note [topdir: How GHC finds its files] in `GHC.SysTools.BaseDir` , fileSettings_globalPackageDatabase :: FilePath + -- ^ Path to the global package database + , fileSettings_libDir :: FilePath + -- ^ Directory containing GHC's library packages and the global package + -- database. Defaults to 'fileSettings_topDir' but can differ in inplace + -- builds used for cross-compilation testing (the "stage2 cross-compiler" + -- scenario). } ===================================== 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 @@ -117,12 +118,6 @@ initSettings top_dir = do then ["-fwrapv", "-fno-builtin"] else [] - -- The package database is either a relative path to the location of the settings file - -- OR an absolute path. - -- In case the path is absolute then top_dir abs_path == abs_path - -- the path is relative then top_dir rel_path == top_dir rel_path - globalpkgdb_path <- installed <$> getSetting "Relative Global Package DB" - let ghc_usage_msg_path = installed "ghc-usage.txt" ghci_usage_msg_path = installed "ghci-usage.txt" @@ -148,6 +143,19 @@ 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 = installed $ fromRight "." $ + getRawFilePathSetting top_dir settingsFile mySettings "LibDir" + + -- The package database is either a relative path to lib_dir OR an absolute path. + -- In case the path is absolute then lib_dir abs_path == abs_path + -- the path is relative then lib_dir rel_path == lib_dir rel_path + globalpkgdb_path <- (lib_dir ) <$> getSetting "Relative Global Package DB" + return $ Settings { sGhcNameVersion = GhcNameVersion { ghcNameVersion_programName = "ghc" @@ -159,6 +167,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 @@ -480,15 +486,25 @@ generateSettings settingsFile = do Stage2 -> pkgUnitId Stage1 base Stage3 -> pkgUnitId Stage2 base - let rel_pkg_db = makeRelativeNoSysLink (dropFileName settingsFile) package_db_path + let -- 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 + + -- addTrailingPathSeparator is needed because makeRelativeNoSysLink uses + -- splitPath internally, where "lib" and "lib/" are distinct components. + lib_topDir :: FilePath <- expr $ addTrailingPathSeparator <$> stageLibPath stage_dir_stage + let rel_pkg_db = makeRelativeNoSysLink lib_topDir package_db_path + 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 [] -> "[]" ===================================== libraries/ghc-boot/GHC/Settings/Utils.hs ===================================== @@ -3,6 +3,7 @@ module GHC.Settings.Utils where import Prelude -- See Note [Why do we import Prelude here?] import Data.Char (isSpace) +import Data.Either (fromRight) import Data.Map (Map) import qualified Data.Map as Map @@ -45,7 +46,10 @@ getTargetArchOS target = tgtArchOs target getGlobalPackageDb :: FilePath -> RawSettings -> Either String FilePath getGlobalPackageDb settingsFile settings = do rel_db <- getRawSetting settingsFile settings "Relative Global Package DB" - return (dropFileName settingsFile rel_db) + let top_dir = dropFileName settingsFile + lib_dir = (top_dir ) $ fromRight "." $ + getRawFilePathSetting top_dir settingsFile settings "LibDir" + return (lib_dir rel_db) -------------------------------------------------------------------------------- -- lib/settings ===================================== testsuite/tests/ghc-api/settings-escape/T19174.hs ===================================== @@ -0,0 +1,130 @@ +module Main where + +import Control.Monad (when) +import Control.Monad.IO.Class (liftIO) +import Data.List (intercalate) +import GHC +import GHC.Driver.DynFlags +import GHC.Driver.Env (hsc_dflags) +import GHC.Settings +import System.Directory +import System.Environment +import System.Exit (ExitCode (ExitFailure), exitWith) +import System.FilePath +import System.IO (hPutStrLn, stderr) +import System.Process (readProcess) +import Unsafe.Coerce (unsafeCoerce) + +-- Verify that a LibDir setting in the settings file is respected: +-- 1. fileSettings_libDir and fileSettings_globalPackageDatabase reflect the +-- configured LibDir path (not topDir) +-- 2. GHC can still compile with a LibDir that differs from topDir +-- 3. --print-libdir and --print-global-package-db output the correct paths +-- +-- We create a symlink to the real lib dir so that the package DB remains +-- findable, but use a separate topDir so that topDir ≠ libDir, proving +-- the LibDir setting is actually used. +-- +-- Tested for both relative and absolute LibDir values. +main :: IO () +main = do + libdir : ghcBin : _ <- getArgs + + (rawSettingOpts, rawTargetOpts, realLibDir) <- runGhc (Just libdir) $ do + dflags <- hsc_dflags <$> getSession + pure (rawSettings dflags, rawTarget dflags, fileSettings_libDir (fileSettings dflags)) + + tmpDir <- getTemporaryDirectory + let topDir = tmpDir "T19174_top" + symlinkLib = tmpDir "T19174_lib" + -- Remove stale dirs from prior runs; createDirectoryLink fails if path exists. + removePathForcibly topDir + removePathForcibly symlinkLib + createDirectoryIfMissing True (topDir "targets") + createDirectoryLink realLibDir symlinkLib + + let testWithLibDir libDirValue = do + writeTopDirFiles topDir rawSettingOpts rawTargetOpts libDirValue + runGhc (Just topDir) $ do + assertSettings topDir symlinkLib + compileAndRunTestExpr + assertGhcFlags ghcBin topDir symlinkLib + + testWithLibDir (".." takeFileName symlinkLib) + testWithLibDir symlinkLib + + putStrLn "OK" + +writeTopDirFiles :: + (Show a) => + FilePath -> + [(String, String)] -> + a -> + String -> + IO () +writeTopDirFiles topDir rawSettingOpts rawTargetOpts libDirValue = do + let settings = filter ((/= "LibDir") . fst) rawSettingOpts ++ [("LibDir", libDirValue)] + writeFile (topDir "settings") $ + "[" ++ intercalate "\n," (map show settings) ++ "]" + writeFile (topDir "targets" "default.target") $ + show rawTargetOpts + +assertSettings :: FilePath -> FilePath -> Ghc () +assertSettings topDir expectedLib = do + dflags <- hsc_dflags <$> getSession + let fs = fileSettings dflags + actualLib = fileSettings_libDir fs + actualPkgDb = fileSettings_globalPackageDatabase fs + normActualLib <- liftIO $ canonicalizePath actualLib + normExpected <- liftIO $ canonicalizePath expectedLib + normTopDir <- liftIO $ canonicalizePath topDir + normActualPkgDb <- liftIO $ canonicalizePath actualPkgDb + normExpectedPkgDb <- liftIO $ canonicalizePath (expectedLib "package.conf.d") + liftIO $ do + when (normActualLib /= normExpected) $ + die + [ "FAIL: libDir should be " ++ normExpected, + " got " ++ normActualLib + ] + when (normActualLib == normTopDir) $ + die ["FAIL: libDir equals topDir — LibDir setting was ignored"] + when (normActualPkgDb /= normExpectedPkgDb) $ + die + [ "FAIL: globalPackageDB should be " ++ normExpectedPkgDb, + " got " ++ normActualPkgDb + ] + +assertGhcFlags :: FilePath -> FilePath -> FilePath -> IO () +assertGhcFlags ghcBin topDir expectedLib = do + normExpectedLib <- canonicalizePath expectedLib + normExpectedPkgDb <- canonicalizePath (expectedLib "package.conf.d") + + printedLibDir <- trim <$> readProcess ghcBin ["-B" ++ topDir, "--print-libdir"] "" + normPrintedLib <- canonicalizePath printedLibDir + when (normPrintedLib /= normExpectedLib) $ + die + [ "FAIL: --print-libdir should be " ++ normExpectedLib, + " got " ++ normPrintedLib + ] + + printedPkgDb <- trim <$> readProcess ghcBin ["-B" ++ topDir, "--print-global-package-db"] "" + normPrintedPkgDb <- canonicalizePath printedPkgDb + when (normPrintedPkgDb /= normExpectedPkgDb) $ + die + [ "FAIL: --print-global-package-db should be " ++ normExpectedPkgDb, + " got " ++ normPrintedPkgDb + ] + +compileAndRunTestExpr :: Ghc () +compileAndRunTestExpr = do + dflags <- getSessionDynFlags + _ <- setSessionDynFlags dflags + setContext [IIDecl (simpleImportDecl (mkModuleName "Prelude"))] + result <- compileExpr "length [1,2,3 :: Int]" + liftIO $ print (unsafeCoerce result :: Int) + +trim :: String -> String +trim = reverse . dropWhile (== '\n') . reverse + +die :: [String] -> IO () +die msgs = mapM_ (hPutStrLn stderr) msgs >> exitWith (ExitFailure 1) ===================================== testsuite/tests/ghc-api/settings-escape/T19174.stdout ===================================== @@ -0,0 +1,3 @@ +3 +3 +OK ===================================== testsuite/tests/ghc-api/settings-escape/all.T ===================================== @@ -1,3 +1,11 @@ +test('T19174', + [ extra_run_opts('"' + config.libdir + '" "' + config.compiler + '"') + , req_interp + # createDirectoryLink uses CreateSymbolicLink on Windows, which requires + # developer mode or admin privileges — may fail on Windows boxes. + ] + , compile_and_run + , ['-package ghc -package directory -package filepath']) test('T24265', [ extra_run_opts('"' + config.libdir + '"') , extra_files(['ghc-install-folder/']) ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e00627ea30555e63d7fd25dc20b45ce... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e00627ea30555e63d7fd25dc20b45ce... You're receiving this email because of your account on gitlab.haskell.org.