diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
index 74daa6660ac7b9bbdb53ffed034e19d8486f3121..bc8e5f5d2899ba8b9986b03e88b57342176d89d7 100644
--- a/Cabal/src/Distribution/Simple/Configure.hs
+++ b/Cabal/src/Distribution/Simple/Configure.hs
@@ -76,7 +76,7 @@ import Distribution.Simple.Program
import Distribution.Simple.Setup as Setup
import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo
-import Distribution.Simple.Program.Db (appendProgramSearchPath, modifyProgramSearchPath)
+import Distribution.Simple.Program.Db (appendProgramSearchPath, modifyProgramSearchPath, lookupProgramByName)
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.PackageVersionConstraint
@@ -102,7 +102,8 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Control.Exception
( try )
import Distribution.Utils.Structured ( structuredDecodeOrFailIO, structuredEncode )
-import Distribution.Compat.Directory ( listDirectory )
+import Distribution.Compat.Directory
+ ( listDirectory, doesPathExist )
import Data.ByteString.Lazy ( ByteString )
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
@@ -115,8 +116,6 @@ import System.Directory
, getTemporaryDirectory, removeFile)
import System.FilePath
( (</>), isAbsolute, takeDirectory )
-import Distribution.Compat.Directory
- ( doesPathExist )
import qualified System.Info
( compilerName, compilerVersion )
import System.IO
@@ -639,21 +638,16 @@ configure (pkg_descr0, pbi) cfg = do
"--enable-split-objs; ignoring")
return False
- let compilerSupportsGhciLibs :: Bool
- compilerSupportsGhciLibs =
- case compilerId comp of
- CompilerId GHC version
- | version > mkVersion [9,3] && windows ->
- False
- CompilerId GHC _ ->
- True
- CompilerId GHCJS _ ->
- True
- _ -> False
- where
- windows = case compPlatform of
- Platform _ Windows -> True
- Platform _ _ -> False
+ -- Basically yes/no/unknown.
+ let linkerSupportsRelocations :: Maybe Bool
+ linkerSupportsRelocations =
+ case lookupProgramByName "ld" programDb'' of
+ Nothing -> Nothing
+ Just ld ->
+ case Map.lookup "Supports relocatable output" $ programProperties ld of
+ Just "YES" -> Just True
+ Just "NO" -> Just False
+ _other -> Nothing
let ghciLibByDefault =
case compilerId comp of
@@ -673,10 +667,12 @@ configure (pkg_descr0, pbi) cfg = do
withGHCiLib_ <-
case fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg) of
- True | not compilerSupportsGhciLibs -> do
+ -- NOTE: If linkerSupportsRelocations is Nothing this may still fail if the
+ -- linker does not support -r.
+ True | not (fromMaybe True linkerSupportsRelocations) -> do
warn verbosity $
- "--enable-library-for-ghci is no longer supported on Windows with"
- ++ " GHC 9.4 and later; ignoring..."
+ "--enable-library-for-ghci is not supported with the current"
+ ++ " linker; ignoring..."
return False
v -> return v
@@ -951,11 +947,11 @@ dependencySatisfiable
then internalDepSatisfiable
else
-- Backward compatibility for the old sublibrary syntax
- (sublibs == mainLibSet
+ sublibs == mainLibSet
&& Map.member
(pn, CLibName $ LSubLibName $
packageNameToUnqualComponentName depName)
- requiredDepsMap)
+ requiredDepsMap
|| all visible sublibs
@@ -982,7 +978,7 @@ dependencySatisfiable
internalDepSatisfiable =
Set.isSubsetOf (NES.toSet sublibs) packageLibraries
internalDepSatisfiableExternally =
- all (\ln -> not $ null $ PackageIndex.lookupInternalDependency installedPackageSet pn vr ln) sublibs
+ all (not . null . PackageIndex.lookupInternalDependency installedPackageSet pn vr) sublibs
-- Check whether a library exists and is visible.
-- We don't disambiguate between dependency on non-existent or private
@@ -1451,8 +1447,7 @@ getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform =
-- flag into a single package db stack.
--
interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack
-interpretPackageDbFlags userInstall specificDBs =
- extra initialStack specificDBs
+interpretPackageDbFlags userInstall = extra initialStack
where
initialStack | userInstall = [GlobalPackageDB, UserPackageDB]
| otherwise = [GlobalPackageDB]
@@ -1698,8 +1693,8 @@ ccLdOptionsBuildInfo cflags ldflags ldflags_static =
let (includeDirs', cflags') = partition ("-I" `isPrefixOf`) cflags
(extraLibs', ldflags') = partition ("-l" `isPrefixOf`) ldflags
(extraLibDirs', ldflags'') = partition ("-L" `isPrefixOf`) ldflags'
- (extraLibsStatic') = filter ("-l" `isPrefixOf`) ldflags_static
- (extraLibDirsStatic') = filter ("-L" `isPrefixOf`) ldflags_static
+ extraLibsStatic' = filter ("-l" `isPrefixOf`) ldflags_static
+ extraLibDirsStatic' = filter ("-L" `isPrefixOf`) ldflags_static
in mempty {
includeDirs = map (drop 2) includeDirs',
extraLibs = map (drop 2) extraLibs',
diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs
index 507831f3cab1fa17f07895ec2b42533bf6f2de46..6b595b75f3a66f993777a63c3b06c137a86b21ef 100644
--- a/Cabal/src/Distribution/Simple/GHC/Internal.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs
@@ -101,7 +101,9 @@ configureToolchain _implInfo ghcProg ghcInfo =
}
. addKnownProgram ldProgram {
programFindLocation = findProg ldProgramName extraLdPath,
- programPostConf = configureLd
+ programPostConf = \v cp ->
+ -- Call any existing configuration first and then add any new configuration
+ configureLd v =<< programPostConf ldProgram v cp
}
. addKnownProgram arProgram {
programFindLocation = findProg arProgramName extraArPath
diff --git a/Cabal/src/Distribution/Simple/Program/Builtin.hs b/Cabal/src/Distribution/Simple/Program/Builtin.hs
index 5bb324f388faabc8ca7306f08d02adbeaf67f9b9..81aee4b93d67ca96b81d227484144dd2444a8d33 100644
--- a/Cabal/src/Distribution/Simple/Program/Builtin.hs
+++ b/Cabal/src/Distribution/Simple/Program/Builtin.hs
@@ -256,8 +256,7 @@ arProgram = simpleProgram "ar"
stripProgram :: Program
stripProgram = (simpleProgram "strip") {
- programFindVersion = \verbosity ->
- findProgramVersion "--version" stripExtractVersion (lessVerbose verbosity)
+ programFindVersion = findProgramVersion "--version" stripExtractVersion . lessVerbose
}
hsc2hsProgram :: Program
@@ -322,7 +321,44 @@ greencardProgram :: Program
greencardProgram = simpleProgram "greencard"
ldProgram :: Program
-ldProgram = simpleProgram "ld"
+ldProgram = (simpleProgram "ld")
+ { programPostConf = \verbosity ldProg -> do
+ -- The `lld` linker cannot create merge (relocatable) objects so we
+ -- want to detect this.
+ -- If the linker does support relocatable objects, we want to use that
+ -- to create partially pre-linked objects for GHCi, so we get much
+ -- faster loading as we do not have to do the separate loading and
+ -- in-memory linking the static linker in GHC does, but can offload
+ -- parts of this process to a pre-linking step.
+ -- However this requires the linker to support this features. Not all
+ -- linkers do, and notably as of this writing `lld` which is a popular
+ -- choice for windows linking does not support this feature. However
+ -- if using binutils ld or another linker that supports --relocatable,
+ -- we should still be good to generate pre-linked objects.
+ ldHelpOutput <-
+ getProgramInvocationOutput
+ verbosity
+ (programInvocation ldProg ["--help"])
+ -- In case the linker does not support '--help'. Eg the LLVM linker,
+ -- `lld` only accepts `-help`.
+ `catchIO` (\_ -> return "")
+ let k = "Supports relocatable output"
+ -- Standard GNU `ld` uses `--relocatable` while `ld.gold` uses
+ -- `-relocatable` (single `-`).
+ v
+ | "-relocatable" `isInfixOf` ldHelpOutput = "YES"
+ -- ld64 on macOS has this lovely response for "--help"
+ --
+ -- ld64: For information on command line options please use 'man ld'.
+ --
+ -- it does however support -r, if you read the manpage
+ -- (e.g. https://www.manpagez.com/man/1/ld64/)
+ | "ld64:" `isPrefixOf` ldHelpOutput = "YES"
+ | otherwise = "NO"
+
+ m = Map.insert k v (programProperties ldProg)
+ return $ ldProg{programProperties = m}
+ }
tarProgram :: Program
tarProgram = (simpleProgram "tar") {
@@ -334,7 +370,7 @@ tarProgram = (simpleProgram "tar") {
-- Some versions of tar don't support '--help'.
`catchIO` (\_ -> return "")
let k = "Supports --format"
- v = if ("--format" `isInfixOf` tarHelpOutput) then "YES" else "NO"
+ v = if "--format" `isInfixOf` tarHelpOutput then "YES" else "NO"
m = Map.insert k v (programProperties tarProg)
return $ tarProg { programProperties = m }
}
diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs
index b9fb61a7913ce5a08fbc24c624d67654cc2a72ad..b1edb84499fb9b2fe550385a243105ad3f1c0ec8 100644
--- a/Cabal/src/Distribution/Simple/Program/Db.hs
+++ b/Cabal/src/Distribution/Simple/Program/Db.hs
@@ -47,6 +47,7 @@ module Distribution.Simple.Program.Db (
userSpecifyArgss,
userSpecifiedArgs,
lookupProgram,
+ lookupProgramByName,
updateProgram,
configuredPrograms,
@@ -309,8 +310,11 @@ userSpecifiedArgs prog =
-- | Try to find a configured program
lookupProgram :: Program -> ProgramDb -> Maybe ConfiguredProgram
-lookupProgram prog = Map.lookup (programName prog) . configuredProgs
+lookupProgram = lookupProgramByName . programName
+-- | Try to find a configured program
+lookupProgramByName :: String -> ProgramDb -> Maybe ConfiguredProgram
+lookupProgramByName name = Map.lookup name . configuredProgs
-- | Update a configured program in the database.
updateProgram :: ConfiguredProgram -> ProgramDb
diff --git a/changelog.d/pr-9443 b/changelog.d/pr-9443
new file mode 100644
index 0000000000000000000000000000000000000000..353f1fb8cbdb2fea1b2f618ec8c7981eb0cb7095
--- /dev/null
+++ b/changelog.d/pr-9443
@@ -0,0 +1,11 @@
+synopsis: Use linker capability detection to improve linker use
+packages: Cabal
+prs: #9443
+
+description: {
+
+- Previously the GHC version number and platform were used as a proxy for whether
+ the linker can generate relocatable objects.
+- Now, the ability of the linker to create relocatable objects is detected.
+
+}