GitLab

David Eichmann pushed to branch wip/davide/hadrian_avoid_response_files_2 at Glasgow Haskell Compiler / GHC

Commits:

e1578f7a

by David Eichmann at 2026-06-02T16:23:12+01:00

Hadrian: avoid response files when command line is short enough

This replaces the logic of always using response files on Windows.
With the new condition based on command line lenght, reponse files
can be avoided in many more cases (on windows).

2 changed files:

hadrian/src/Builder.hs
hadrian/src/Hadrian/Utilities.hs

Changes:

hadrian/src/Builder.hs

@@ -351,9 +351,10 @@ instance H.Builder Builder where
                    -- NB: we can't put the buildArgs in a response file, because some flags require
                    -- empty arguments (such as the -dep-suffix flag), but that isn't supported
                    -- yet due to #26560.
 -                  withResponseFileOnWindows
 -                    (\buildInputs' -> cmd [path] buildArgs buildInputs' buildOptions)
 +                  withResponseFileIfLongCmd
 +                    (toCmdArgument [path] <> toCmdArgument buildArgs)
                      buildInputs
 +                    (toCmdArgument buildOptions)
                  HsCpp    -> captureStdout
@@ -393,9 +394,10 @@ runHaddock :: FilePath    -- ^ path to @haddock@
        -> [String]
        -> [FilePath]  -- ^ input file paths
        -> Action ()
 -runHaddock haddockPath flagArgs fileInputs = withResponseFileOnWindows
 -  (cmd [haddockPath] flagArgs)
 +runHaddock haddockPath flagArgs fileInputs = withResponseFileIfLongCmd
 +  (toCmdArgument [haddockPath] <> toCmdArgument flagArgs)
    fileInputs
 +  (CmdArgument [])
  -- TODO: Some builders are required only on certain platforms. For example,
  -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform

hadrian/src/Hadrian/Utilities.hs

 +{-# LANGUAGE ImpredicativeTypes #-}
  {-# LANGUAGE TypeFamilies #-}
++
  module Hadrian.Utilities (
      -- * List manipulation
      fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize,
@@ -14,7 +16,7 @@ module Hadrian.Utilities (
      -- * Paths
      BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
 -    KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileOnWindows,
 +    KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileIfLongCmd,
      -- * File system operations
      copyFile, copyFileUntracked, createFileLink, fixFile,
@@ -50,7 +52,6 @@ import Development.Shake.Classes
  import Development.Shake.FilePath
  import GHC.ResponseFile (escapeArgs)
  import System.Environment (lookupEnv)
 -import System.Info.Extra (isWindows)
  import System.IO (hClose, openTempFile)
  import System.IO.Error (isPermissionError)
@@ -61,6 +62,7 @@ import qualified System.Directory.Extra as IO
  import qualified System.Info.Extra      as IO
  import qualified System.IO              as IO
  import qualified System.FilePath.Posix  as Posix
 +import Development.Shake.Command (CmdArgument (..), IsCmdArgument (toCmdArgument))
  -- | Extract a value from a singleton list, or terminate with an error message
  -- if the list does not contain exactly one value.
@@ -330,20 +332,26 @@ keepResponseFiles = do
      KeepResponseFiles keep <- userSetting (KeepResponseFiles False)
      return keep
 --- | Run an action either with command arguments direcly or by, on Windows,
 --- placing those arguments into a response file escaped with @GHC.ResponseFile.escapeArgs@.
 +-- | Run an command with the given arguments. If the command is too long then the
 +-- response file arguments are placed into a response file and escaped with @GHC.ResponseFile.escapeArgs@.
  --
  -- With @--keep-response-files@, the file is left on disk (if used)
 -withResponseFileOnWindows ::
 -    ([String] -> Action a)  -- ^ Action to perform given arguments (of the form @["\@reponseFilePath"]@ on Windows)
 -    -> [String]             -- ^ Command arguments
 -    -> Action a
 -withResponseFileOnWindows action commandArgs = do
 -    if isWindows
 +withResponseFileIfLongCmd :: (CmdResult c) =>
 +    CmdArgument     -- ^ Command and arguments before the response file arguments.
 +    -> [String]     -- ^ Response file aruguments.
 +    -> CmdArgument  -- ^ Command arguments after the response file arguments.
 +    -> Action c
 +withResponseFileIfLongCmd argsPre argsResp argsPost = do
 +    let cmdLineLengh = sum
 +            [ length arg
 +            | let CmdArgument args = argsPre <> toCmdArgument argsResp <> argsPost
 +            , Right arg <- args
 +            ]
 +    if cmdLineLengh >= cmdLineLengthLimit
          then withResponseFile $ \tmp -> do
 -                writeFile' tmp (escapeArgs commandArgs)
 -                action ['@' : tmp]
 -        else action commandArgs
 +                writeFile' tmp (escapeArgs argsResp)
 +                cmd argsPre ('@' : tmp) argsPost
 +        else cmd argsPre argsResp argsPost
  -- | Run an action with a response file path.
  --