Commit 6cde9851 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add new mode for Ar builder: useAtFile (big performance increase).

parent 2ed0b041
module Rules.Actions (build, buildWithResources) where
import Expression
import Oracles
import Oracles.ArgsHash
import Settings
import Settings.Args
......@@ -18,19 +17,13 @@ buildWithResources rs target = do
path <- builderPath builder
argList <- interpret target getArgs
-- The line below forces the rule to be rerun if the args hash has changed
when trackBuildSystem $ checkArgsHash target
checkArgsHash target
withResources rs $ do
putBuild $ "/--------\n" ++ "| Running "
++ show builder ++ " with arguments:"
putBuild $ "/--------\n| Running " ++ show builder ++ " with arguments:"
mapM_ (putBuild . ("| " ++)) $ interestingInfo builder argList
putBuild $ "\\--------"
quietly $ case builder of
Ar -> do -- Split argument list into chunks as otherwise Ar chokes up
maxChunk <- cmdLineLengthLimit
let persistentArgs = take arPersistentArgsCount argList
remainingArgs = drop arPersistentArgsCount argList
forM_ (chunksOfSize maxChunk remainingArgs) $ \argsChunk ->
unit . cmd [path] $ persistentArgs ++ argsChunk
Ar -> arCmd path argList
HsCpp -> do
let file = head $ Target.files target -- TODO: ugly
......@@ -63,14 +56,14 @@ interestingInfo builder ss = case builder of
Haddock -> prefixAndSuffix 1 0 ss
Happy -> prefixAndSuffix 0 3 ss
Hsc2Hs -> prefixAndSuffix 0 3 ss
HsCpp -> prefixAndSuffix 0 1 ss
Ld -> prefixAndSuffix 4 0 ss
_ -> ss
where
prefixAndSuffix n m list =
if length list <= n + m + 1
let len = length list in
if len <= n + m + 1
then list
else take n list
++ ["... skipping "
++ show (length list - n - m)
++ " arguments ..."]
++ drop (length list - m) list
++ ["... skipping " ++ show (len - n - m) ++ " arguments ..."]
++ drop (len - m) list
module Settings.Builders.Ar (arArgs, arPersistentArgsCount) where
module Settings.Builders.Ar (arArgs, arCmd) where
import Expression
import Oracles
import Predicates (builder)
arArgs :: Args
......@@ -13,5 +14,29 @@ arArgs = builder Ar ? do
-- This count includes arg "q" and arg file parameters in arArgs (see above).
-- Update this value appropriately when changing arArgs.
arPersistentArgsCount :: Int
arPersistentArgsCount = 2
arFlagsCount :: Int
arFlagsCount = 2
-- Ar needs to be invoked in a special way: we pass the list of files to be
-- archived via a temporary file as otherwise Ar (or rather Windows command
-- line) chokes up. Alternatively, we split argument list into chunks and call
-- ar multiple times (when passing files via a separate file is not supported).
arCmd :: FilePath -> [String] -> Action ()
arCmd path argList = do
arSupportsAtFile <- flag ArSupportsAtFile
let flagArgs = take arFlagsCount argList
fileArgs = drop arFlagsCount argList
if arSupportsAtFile
then useAtFile path flagArgs fileArgs
else useSuccessiveInvokations path flagArgs fileArgs
useAtFile :: FilePath -> [String] -> [String] -> Action ()
useAtFile path flagArgs fileArgs = withTempFile $ \tmp -> do
writeFile' tmp $ unwords fileArgs
cmd [path] flagArgs ('@' : tmp)
useSuccessiveInvokations :: FilePath -> [String] -> [String] -> Action ()
useSuccessiveInvokations path flagArgs fileArgs = do
maxChunk <- cmdLineLengthLimit
forM_ (chunksOfSize maxChunk fileArgs) $ \argsChunk ->
unit . cmd [path] $ flagArgs ++ argsChunk
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