diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2022-05-30 11:56:05 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-05-30 19:17:35 -0400 |
commit | 83467435c4ea81daa7b97ed5d914f543f9e885a3 (patch) | |
tree | 0e674539aae874711a260f6aa3a373ddce1dabaa | |
parent | 0544f114a6aafa868d7a75f3fd77a9c5239be8d9 (diff) | |
download | haskell-83467435c4ea81daa7b97ed5d914f543f9e885a3.tar.gz |
Avoid using DynFlags in GHC.Linker.Unit (#17957)
-rw-r--r-- | compiler/GHC/Linker/Dynamic.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Linker/ExtraObj.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Linker/Static.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/Linker/Unit.hs | 30 |
4 files changed, 30 insertions, 23 deletions
diff --git a/compiler/GHC/Linker/Dynamic.hs b/compiler/GHC/Linker/Dynamic.hs index c62a6e2242..17c178ea85 100644 --- a/compiler/GHC/Linker/Dynamic.hs +++ b/compiler/GHC/Linker/Dynamic.hs @@ -83,7 +83,10 @@ linkDynLib logger tmpfs dflags0 unit_env o_files dep_packages | gopt Opt_LinkRts dflags = pkgs_with_rts | otherwise = pkgs_without_rts pkg_link_opts = package_hs_libs ++ extra_libs ++ other_flags - where (package_hs_libs, extra_libs, other_flags) = collectLinkOpts dflags pkgs + where + namever = ghcNameVersion dflags + ways_ = ways dflags + (package_hs_libs, extra_libs, other_flags) = collectLinkOpts namever ways_ pkgs -- probably _stub.o files -- and last temporary shared object file diff --git a/compiler/GHC/Linker/ExtraObj.hs b/compiler/GHC/Linker/ExtraObj.hs index 163bccf3fe..90cf2466e5 100644 --- a/compiler/GHC/Linker/ExtraObj.hs +++ b/compiler/GHC/Linker/ExtraObj.hs @@ -192,7 +192,7 @@ mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_packages = do -- See Note [LinkInfo section] getLinkInfo :: DynFlags -> UnitEnv -> [UnitId] -> IO String getLinkInfo dflags unit_env dep_packages = do - package_link_opts <- getUnitLinkOpts dflags unit_env dep_packages + package_link_opts <- getUnitLinkOpts (ghcNameVersion dflags) (ways dflags) unit_env dep_packages pkg_frameworks <- if not (platformUsesFrameworks (ue_platform unit_env)) then return [] else do diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs index 95c2f2e430..b81b286d54 100644 --- a/compiler/GHC/Linker/Static.hs +++ b/compiler/GHC/Linker/Static.hs @@ -70,6 +70,8 @@ linkBinary logger tmpfs dflags unit_env o_files dep_units = do toolSettings' = toolSettings dflags verbFlags = getVerbFlags dflags output_fn = exeFileName platform False (outputFile_ dflags) + namever = ghcNameVersion dflags + ways_ = ways dflags -- get the full list of packages to link with, by combining the -- explicit packages with the auto packages and all of their @@ -80,12 +82,12 @@ linkBinary logger tmpfs dflags unit_env o_files dep_units = do else do d <- getCurrentDirectory return $ normalise (d </> output_fn) pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units) - let pkg_lib_paths = collectLibraryDirs (ways dflags) pkgs + let pkg_lib_paths = collectLibraryDirs ways_ pkgs let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths get_pkg_lib_path_opts l | osElfTarget (platformOS platform) && dynLibLoader dflags == SystemDependent && - ways dflags `hasWay` WayDyn + ways_ `hasWay` WayDyn = let libpath = if gopt Opt_RelativeDynlibPaths dflags then "$ORIGIN" </> (l `makeRelativeTo` full_output_fn) @@ -106,7 +108,7 @@ linkBinary logger tmpfs dflags unit_env o_files dep_units = do in ["-L" ++ l] ++ rpathlink ++ rpath | osMachOTarget (platformOS platform) && dynLibLoader dflags == SystemDependent && - ways dflags `hasWay` WayDyn && + ways_ `hasWay` WayDyn && useXLinkerRPath dflags (platformOS platform) = let libpath = if gopt Opt_RelativeDynlibPaths dflags then "@loader_path" </> @@ -118,7 +120,7 @@ linkBinary logger tmpfs dflags unit_env o_files dep_units = do pkg_lib_path_opts <- if gopt Opt_SingleLibFolder dflags then do - libs <- getLibs dflags unit_env dep_units + libs <- getLibs namever ways_ unit_env dep_units tmpDir <- newTempDir logger tmpfs (tmpDir dflags) sequence_ [ copyFile lib (tmpDir </> basename) | (lib, basename) <- libs] @@ -148,7 +150,7 @@ linkBinary logger tmpfs dflags unit_env o_files dep_units = do = ([],[]) pkg_link_opts <- do - (package_hs_libs, extra_libs, other_flags) <- getUnitLinkOpts dflags unit_env dep_units + (package_hs_libs, extra_libs, other_flags) <- getUnitLinkOpts namever ways_ unit_env dep_units return $ other_flags ++ dead_strip ++ pre_hs_libs ++ package_hs_libs ++ post_hs_libs ++ extra_libs @@ -266,6 +268,8 @@ linkStaticLib logger dflags unit_env o_files dep_units = do extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ] modules = o_files ++ extra_ld_inputs output_fn = exeFileName platform True (outputFile_ dflags) + namever = ghcNameVersion dflags + ways_ = ways dflags full_output_fn <- if isAbsolute output_fn then return output_fn @@ -282,7 +286,7 @@ linkStaticLib logger dflags unit_env o_files dep_units = do | otherwise = filter ((/= rtsUnitId) . unitId) pkg_cfgs_init - archives <- concatMapM (collectArchives dflags) pkg_cfgs + archives <- concatMapM (collectArchives namever ways_) pkg_cfgs ar <- foldl mappend <$> (Archive <$> mapM loadObj modules) diff --git a/compiler/GHC/Linker/Unit.hs b/compiler/GHC/Linker/Unit.hs index 718d5667bc..6965edd707 100644 --- a/compiler/GHC/Linker/Unit.hs +++ b/compiler/GHC/Linker/Unit.hs @@ -18,7 +18,7 @@ import GHC.Utils.Misc import qualified GHC.Data.ShortText as ST -import GHC.Driver.Session +import GHC.Settings import Control.Monad import System.Directory @@ -26,26 +26,26 @@ import System.FilePath -- | Find all the link options in these and the preload packages, -- returning (package hs lib options, extra library options, other flags) -getUnitLinkOpts :: DynFlags -> UnitEnv -> [UnitId] -> IO ([String], [String], [String]) -getUnitLinkOpts dflags unit_env pkgs = do +getUnitLinkOpts :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO ([String], [String], [String]) +getUnitLinkOpts namever ways unit_env pkgs = do ps <- mayThrowUnitErr $ preloadUnitsInfo' unit_env pkgs - return (collectLinkOpts dflags ps) + return (collectLinkOpts namever ways ps) -collectLinkOpts :: DynFlags -> [UnitInfo] -> ([String], [String], [String]) -collectLinkOpts dflags ps = +collectLinkOpts :: GhcNameVersion -> Ways -> [UnitInfo] -> ([String], [String], [String]) +collectLinkOpts namever ways ps = ( - concatMap (map ("-l" ++) . unitHsLibs (ghcNameVersion dflags) (ways dflags)) ps, + concatMap (map ("-l" ++) . unitHsLibs namever ways) ps, concatMap (map ("-l" ++) . map ST.unpack . unitExtDepLibsSys) ps, concatMap (map ST.unpack . unitLinkerOptions) ps ) -collectArchives :: DynFlags -> UnitInfo -> IO [FilePath] -collectArchives dflags pc = +collectArchives :: GhcNameVersion -> Ways -> UnitInfo -> IO [FilePath] +collectArchives namever ways pc = filterM doesFileExist [ searchPath </> ("lib" ++ lib ++ ".a") | searchPath <- searchPaths , lib <- libs ] - where searchPaths = ordNub . filter notNull . libraryDirsForWay (ways dflags) $ pc - libs = unitHsLibs (ghcNameVersion dflags) (ways dflags) pc ++ map ST.unpack (unitExtDepLibsSys pc) + where searchPaths = ordNub . filter notNull . libraryDirsForWay ways $ pc + libs = unitHsLibs namever ways pc ++ map ST.unpack (unitExtDepLibsSys pc) -- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way. libraryDirsForWay :: Ways -> UnitInfo -> [String] @@ -53,11 +53,11 @@ libraryDirsForWay ws | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs | otherwise = map ST.unpack . unitLibraryDirs -getLibs :: DynFlags -> UnitEnv -> [UnitId] -> IO [(String,String)] -getLibs dflags unit_env pkgs = do +getLibs :: GhcNameVersion -> Ways -> UnitEnv -> [UnitId] -> IO [(String,String)] +getLibs namever ways unit_env pkgs = do ps <- mayThrowUnitErr $ preloadUnitsInfo' unit_env pkgs fmap concat . forM ps $ \p -> do - let candidates = [ (l </> f, f) | l <- collectLibraryDirs (ways dflags) [p] - , f <- (\n -> "lib" ++ n ++ ".a") <$> unitHsLibs (ghcNameVersion dflags) (ways dflags) p ] + let candidates = [ (l </> f, f) | l <- collectLibraryDirs ways [p] + , f <- (\n -> "lib" ++ n ++ ".a") <$> unitHsLibs namever ways p ] filterM (doesFileExist . fst) candidates |