Invoke ar to create .a library only once by default

Newer versions of ar program support @file argument, which allows to
supply all object files, however numerous, in one call to ar, thus
reducing overhead of creating multiple ar processes where each process
must fully re-read output of the previous invocation.
parent c635089b
......@@ -61,6 +61,7 @@ module Distribution.Simple.Compiler (
coverageSupported,
profilingSupported,
backpackSupported,
arResponseFilesSupported,
libraryDynDirSupported,
-- * Support for profiling detail levels
......@@ -339,6 +340,11 @@ libraryDynDirSupported comp = case compilerFlavor comp of
where
v = compilerVersion comp
-- | Does this compiler's "ar" command supports response file
-- arguments (i.e. @file-style arguments).
arResponseFilesSupported :: Compiler -> Bool
arResponseFilesSupported = ghcSupported "ar supports at file"
-- | Does this compiler support Haskell program coverage?
coverageSupported :: Compiler -> Bool
coverageSupported comp =
......
......@@ -24,14 +24,17 @@ import Distribution.Compat.Prelude
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Distribution.Compat.CopyFile (filesEqual)
import Distribution.Simple.Compiler (arResponseFilesSupported)
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Program
( arProgram, requireProgram )
( ProgramInvocation, arProgram, requireProgram )
import Distribution.Simple.Program.Run
( programInvocation, multiStageProgramInvocation
, runProgramInvocation )
import Distribution.Simple.Setup
( fromFlagOrDefault, configArDoesNotSupportResponseFiles )
import Distribution.Simple.Utils
( dieWithLocation', withTempDirectory )
( dieWithLocation', withTempFile, withTempDirectory )
import Distribution.System
( Arch(..), OS(..), Platform(..) )
import Distribution.Verbosity
......@@ -40,7 +43,7 @@ import System.Directory (doesFileExist, renameFile)
import System.FilePath ((</>), splitFileName)
import System.IO
( Handle, IOMode(ReadWriteMode), SeekMode(AbsoluteSeek)
, hFileSize, hSeek, withBinaryFile )
, hPutStrLn, hClose, hFileSize, hSeek, withBinaryFile )
-- | Call @ar@ to create a library archive from a bunch of object files.
--
......@@ -83,10 +86,29 @@ createArLibArchive verbosity lbi targetPath files = do
middle = initial
final = programInvocation ar (finalArgs ++ extraArgs)
sequence_
oldVersionManualOverride =
fromFlagOrDefault False $
configArDoesNotSupportResponseFiles $
configFlags lbi
responseArgumentsNotSupported =
not (arResponseFilesSupported (compiler lbi))
invokeWithResponesFile :: FilePath -> ProgramInvocation
invokeWithResponesFile atFile =
programInvocation ar $
simpleArgs ++ extraArgs ++ ['@' : atFile]
if oldVersionManualOverride || responseArgumentsNotSupported
then
sequence_
[ runProgramInvocation verbosity inv
| inv <- multiStageProgramInvocation
simple (initial, middle, final) files ]
else
withTempFile tmpDir ".rsp" $ \responeFilePath responseFileHandle -> do
hPutStrLn responseFileHandle $ unlines $ map escapeFileName files
hClose responseFileHandle
runProgramInvocation verbosity $ invokeWithResponesFile responeFilePath
unless (hostArch == Arm -- See #1537
|| hostOS == AIX) $ -- AIX uses its own "ar" format variant
......@@ -97,9 +119,26 @@ createArLibArchive verbosity lbi targetPath files = do
where
progDb = withPrograms lbi
Platform hostArch hostOS = hostPlatform lbi
verbosityOpts v | v >= deafening = ["-v"]
| v >= verbose = []
| otherwise = ["-c"]
verbosityOpts v
| v >= deafening = ["-v"]
| v >= verbose = []
| otherwise = ["-c"] -- Do not warn if library had to be created.
-- | The @ar@ tool expects response file to contain sequence of strings
-- delimited by whitespace. Thus, in order to handle file names with spaces
-- they should be enclosed in single or double quotes.
--
-- Windows poses additional challenge to creating correct response files.
-- Namely, on Windows standard path separator is backspace but in @ar@
-- response file format it's escape sequence. Therefore backslashes must
-- be escaped as well.
escapeFileName :: FilePath -> FilePath
escapeFileName = concatMap escapeChar
where
escapeChar :: Char -> String
escapeChar '"' = "\\\""
escapeChar '\\' = "\\\\"
escapeChar c = [c]
-- | @ar@ by default includes various metadata for each object file in their
-- respective headers, so the output can differ for the same inputs, making
......
......@@ -354,7 +354,10 @@ data ConfigFlags = ConfigFlags {
configFlagError :: Flag String,
-- ^Halt and show an error message indicating an error in flag assignment
configRelocatable :: Flag Bool, -- ^ Enable relocatable package built
configDebugInfo :: Flag DebugInfoLevel -- ^ Emit debug info.
configDebugInfo :: Flag DebugInfoLevel, -- ^ Emit debug info.
configArDoesNotSupportResponseFiles :: Flag Bool
-- ^ Enable old code paths for old versions of 'ar' that don't
-- support @file arguments
}
deriving (Generic, Read, Show)
......@@ -411,6 +414,7 @@ instance Eq ConfigFlags where
&& equal configFlagError
&& equal configRelocatable
&& equal configDebugInfo
&& equal configArDoesNotSupportResponseFiles
where
equal f = on (==) f a b
......@@ -456,7 +460,8 @@ defaultConfigFlags progDb = emptyConfigFlags {
configExactConfiguration = Flag False,
configFlagError = NoFlag,
configRelocatable = Flag False,
configDebugInfo = Flag NoDebugInfo
configDebugInfo = Flag NoDebugInfo,
configArDoesNotSupportResponseFiles = NoFlag
}
configureCommand :: ProgramDb -> CommandUI ConfigFlags
......@@ -748,6 +753,12 @@ configureOptions showOrParseArgs =
"building a package that is relocatable. (GHC only)"
configRelocatable (\v flags -> flags { configRelocatable = v})
(boolOpt [] [])
,option "" ["ar-does-not-support-response-files"]
"enable workaround for old versions of \"ar\" that do not support @file arguments"
configArDoesNotSupportResponseFiles
(\v flags -> flags { configArDoesNotSupportResponseFiles = v })
(boolOpt' ([],["ar-does-not-support-response-files"]) ([], []))
]
where
readFlagList :: String -> FlagAssignment
......
......@@ -1282,7 +1282,7 @@ Miscellaneous options
used at all:
::
# Note: this is just syntax sugar for '> 1 && < 1', and is
# supported by build-depends.
$ cabal install --constraint="bar -none"
......@@ -1356,6 +1356,15 @@ Miscellaneous options
Specify a soft constraint on versions of a package. The solver will
attempt to satisfy these preferences on a "best-effort" basis.
.. option:: --ar-does-not-support-response-files
Enable workaround for older versions of ``ar`` program that do not
support response file arguments (i.e. ``@file`` arguments). You
may want this flag only if you specify custom ar executable. For
system ``ar`` or the one bundled with ``ghc`` on Windows the
``cabal`` should do the right thing and hence should normally not
require this flag.
.. _setup-build:
setup build
......
......@@ -331,7 +331,8 @@ instance Semigroup SavedConfig where
configLibCoverage = combine configLibCoverage,
configExactConfiguration = combine configExactConfiguration,
configFlagError = combine configFlagError,
configRelocatable = combine configRelocatable
configRelocatable = combine configRelocatable,
configArDoesNotSupportResponseFiles = combine configArDoesNotSupportResponseFiles
}
where
combine = combine' savedConfigureFlags
......
......@@ -592,7 +592,8 @@ convertToLegacyAllPackageConfig
configBenchmarks = mempty,
configFlagError = mempty, --TODO: ???
configRelocatable = mempty,
configDebugInfo = mempty
configDebugInfo = mempty,
configArDoesNotSupportResponseFiles = mempty
}
haddockFlags = mempty {
......@@ -657,7 +658,8 @@ convertToLegacyPerPackageConfig PackageConfig {..} =
configBenchmarks = packageConfigBenchmarks,
configFlagError = mempty, --TODO: ???
configRelocatable = packageConfigRelocatable,
configDebugInfo = packageConfigDebugInfo
configDebugInfo = packageConfigDebugInfo,
configArDoesNotSupportResponseFiles = mempty
}
installFlags = mempty {
......
......@@ -3070,7 +3070,7 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
configScratchDir = mempty -- never use
configUserInstall = mempty -- don't rely on defaults
configPrograms_ = mempty -- never use, shouldn't exist
configArDoesNotSupportResponseFiles = mempty
setupHsConfigureArgs :: ElaboratedConfiguredPackage
-> [String]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment