src/Distribution/Simple/Program/Ld.hs

    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.Program.Ld
    -- Copyright   :  Duncan Coutts 2009
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- This module provides an library interface to the @ld@ linker program.

    module Distribution.Simple.Program.Ld (
        combineObjectFiles,
      ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Simple.Compiler (arResponseFilesSupported)
    import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
    import Distribution.Simple.Program.ResponseFile
             ( withResponseFile )
    import Distribution.Simple.Program.Run
             ( ProgramInvocation, programInvocation, multiStageProgramInvocation
             , runProgramInvocation )
    import Distribution.Simple.Program.Types
             ( ConfiguredProgram(..) )
    import Distribution.Simple.Setup
             ( fromFlagOrDefault, configUseResponseFiles )
    import Distribution.Simple.Utils
             ( defaultTempFileOptions )
    import Distribution.Verbosity
             ( Verbosity )

    import System.Directory
             ( renameFile )
    import System.FilePath
             ( (<.>), takeDirectory )

    -- | Call @ld -r@ to link a bunch of object files together.
    --
    combineObjectFiles :: Verbosity -> LocalBuildInfo -> ConfiguredProgram
                       -> FilePath -> [FilePath] -> IO ()
    combineObjectFiles verbosity lbi ld target files = do

      -- Unlike "ar", the "ld" tool is not designed to be used with xargs. That is,
      -- if we have more object files than fit on a single command line then we
      -- have a slight problem. What we have to do is link files in batches into
      -- a temp object file and then include that one in the next batch.

      let simpleArgs  = ["-r", "-o", target]

          initialArgs = ["-r", "-o", target]
          middleArgs  = ["-r", "-o", target, tmpfile]
          finalArgs   = middleArgs

          simple      = programInvocation ld simpleArgs
          initial     = programInvocation ld initialArgs
          middle      = programInvocation ld middleArgs
          final       = programInvocation ld finalArgs

          targetDir   = takeDirectory target

          invokeWithResponesFile :: FilePath -> ProgramInvocation
          invokeWithResponesFile atFile =
            programInvocation ld $ simpleArgs ++ ['@' : atFile]

          oldVersionManualOverride =
            fromFlagOrDefault False $ configUseResponseFiles $ configFlags lbi
          -- Whether ghc's ar supports response files is a good proxy for
          -- whether ghc's ld supports them as well.
          responseArgumentsNotSupported   =
            not (arResponseFilesSupported (compiler lbi))

      if oldVersionManualOverride || responseArgumentsNotSupported
        then
          run $ multiStageProgramInvocation simple (initial, middle, final) files
        else
          withResponseFile verbosity defaultTempFileOptions targetDir "ld.rsp" Nothing files $
            \path -> runProgramInvocation verbosity $ invokeWithResponesFile path

      where
        tmpfile        = target <.> "tmp" -- perhaps should use a proper temp file

        run :: [ProgramInvocation] -> IO ()
        run []         = return ()
        run [inv]      = runProgramInvocation verbosity inv
        run (inv:invs) = do runProgramInvocation verbosity inv
                            renameFile target tmpfile
                            run invs