From 1c192961c372b832e23e229af458c082872324f8 Mon Sep 17 00:00:00 2001 From: Gabriella Gonzalez Date: Wed, 18 Oct 2023 16:07:21 -0700 Subject: [PATCH] Use response files for `ghc` invocations 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. --- Cabal/src/Distribution/Simple/GHC.hs | 4 +- Cabal/src/Distribution/Simple/Program/GHC.hs | 73 ++++++++++++++++++++ 2 files changed, 75 insertions(+), 2 deletions(-) diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 3c380a41a86..92c273091b6 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -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 @@ -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 diff --git a/Cabal/src/Distribution/Simple/Program/GHC.hs b/Cabal/src/Distribution/Simple/Program/GHC.hs index 537e008c17f..f853fed7721 100644 --- a/Cabal/src/Distribution/Simple/Program/GHC.hs +++ b/Cabal/src/Distribution/Simple/Program/GHC.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} @@ -13,6 +14,7 @@ module Distribution.Simple.Program.GHC , ghcInvocation , renderGhcOptions , runGHC + , runGHCWithResponseFile , packageDbArgsDb , normaliseGhcArgs ) where @@ -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) @@ -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