Skip to content

Commit

Permalink
Use response files for ghc invocations
Browse files Browse the repository at this point in the history
Before this change, `cabal` could fail with the following error message
when building very large Haskell packages:

```
ghc: createProcess: posix_spawnp: resource exhausted (Argument list too long)
```

This is because when the number of modules or dependencies grows large
enough, then the `ghc` command line can potentially exceed the
`ARG_MAX` command line length limit.

However, `ghc` supports response files in order to work around these
sorts of command line length limitations, so this change enables the
use of those response files.

Note that this requires taking a special precaution to not pass RTS
options to the response file because there's no way that `ghc` can
support RTS options via the response file.  The reason why is because
the Haskell runtime processes these options (not `ghc`), so if you
store the RTS options in the response file then `ghc`'s command line
parser won't know what to do with them.

This means that `ghc` commands can still potentially fail if the RTS
options get long enough, but this is less likely to occur in practice
since RTS options tend to be significantly smaller than non-RTS
options.

This also requires skipping the response file if the first argument
is `--interactive`.  See the corresponding code comment which explains
why in more detail.
  • Loading branch information
Gabriella439 committed Oct 24, 2023
1 parent bc7e8fc commit 1c19296
Show file tree
Hide file tree
Showing 2 changed files with 75 additions and 2 deletions.
4 changes: 2 additions & 2 deletions Cabal/src/Distribution/Simple/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -625,7 +625,7 @@ buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
relLibTargetDir <- makeRelativeToCurrentDirectory libTargetDir

(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg comp platform
let runGhcProg = runGHCWithResponseFile (buildDir lbi) "ghc.rsp" Nothing verbosity ghcProg comp platform

let libBi = libBuildInfo lib

Expand Down Expand Up @@ -1528,7 +1528,7 @@ gbuild verbosity numJobs pkg_descr lbi bm clbi = do
comp = compiler lbi
platform = hostPlatform lbi
implInfo = getImplInfo comp
runGhcProg = runGHC verbosity ghcProg comp platform
runGhcProg = runGHCWithResponseFile (buildDir lbi) "ghc.rsp" Nothing verbosity ghcProg comp platform

let bnfo = gbuildInfo bm

Expand Down
73 changes: 73 additions & 0 deletions Cabal/src/Distribution/Simple/Program/GHC.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
Expand All @@ -13,6 +14,7 @@ module Distribution.Simple.Program.GHC
, ghcInvocation
, renderGhcOptions
, runGHC
, runGHCWithResponseFile
, packageDbArgsDb
, normaliseGhcArgs
) where
Expand All @@ -28,13 +30,16 @@ import Distribution.Pretty
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
import Distribution.Simple.GHC.ImplInfo
import Distribution.Simple.Program.ResponseFile
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils (defaultTempFileOptions)
import Distribution.System
import Distribution.Types.ComponentId
import Distribution.Utils.NubList
import Distribution.Verbosity
import Distribution.Version
import GHC.IO.Encoding (TextEncoding)
import Language.Haskell.Extension

import Data.List (stripPrefix)
Expand Down Expand Up @@ -618,6 +623,74 @@ runGHC
runGHC verbosity ghcProg comp platform opts = do
runProgramInvocation verbosity (ghcInvocation ghcProg comp platform opts)

runGHCWithResponseFile
:: FilePath
-> FilePath
-> Maybe TextEncoding
-> Verbosity
-> ConfiguredProgram
-> Compiler
-> Platform
-> GhcOptions
-> IO ()
runGHCWithResponseFile workDir fileNameTemplate encoding verbosity ghcProg comp platform opts = do
let invocation = ghcInvocation ghcProg comp platform opts

-- Don't use response files if the first argument is `--interactive`, for
-- two related reasons.
--
-- `hie-bios` relies on a hack to intercept the command-line that `Cabal`
-- supplies to `ghc`. Specifically, `hie-bios` creates a script around
-- `ghc` that detects if the first option is `--interactive` and if so then
-- instead of running `ghc` it prints the command-line that `ghc` was given
-- instead of running the command:
--
-- https://github.com/haskell/hie-bios/blob/ce863dba7b57ded20160b4f11a487e4ff8372c08/wrappers/cabal#L7
--
-- … so we can't store that flag in the response file, otherwise that will
-- break. However, even if we were to add a special-case to keep that flag
-- out of the response file things would still break because `hie-bios`
-- stores the arguments to `ghc` that the wrapper script outputs and reuses
-- them later. That breaks if you use a response file because it will
-- store an argument like `@…/ghc36000-0.rsp` which is a temporary path
-- that no longer exists after the wrapper script completes.
--
-- The work-around here is that we don't use a response file at all if the
-- first argument (and only the first argument) to `ghc` is
-- `--interactive`. This ensures that `hie-bios` and all downstream
-- utilities (e.g. `haskell-language-server`) continue working.
case progInvokeArgs invocation of
"--interactive" : _ ->
runProgramInvocation verbosity invocation
args -> do
let (responseFileArgs, otherArgs) = splitArgs False args

withResponseFile
verbosity
defaultTempFileOptions
workDir
fileNameTemplate
encoding
responseFileArgs
\responseFile -> do
let newInvocation =
invocation{progInvokeArgs = ('@' : responseFile) : otherArgs}

runProgramInvocation verbosity newInvocation
where
splitArgs isRTSOption (arg : args) = (newResponseFileArgs, newOtherArgs)
where
(newIsRTSOption, newResponseFileArgs, newOtherArgs) =
case arg of
"+RTS" -> (True, responseFileArgs, arg : otherArgs)
"-RTS" -> (False, responseFileArgs, arg : otherArgs)
_
| isRTSOption -> (isRTSOption, responseFileArgs, arg : otherArgs)
| otherwise -> (isRTSOption, arg : responseFileArgs, otherArgs)

~(responseFileArgs, otherArgs) = splitArgs newIsRTSOption args
splitArgs _ [] = ([], [])

ghcInvocation
:: ConfiguredProgram
-> Compiler
Expand Down

0 comments on commit 1c19296

Please sign in to comment.