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 Distribution.Compat.Prelude
import Prelude ()

import Distribution.Simple.Compiler (arResponseFilesSupported)
import Distribution.Simple.Flag
  ( fromFlagOrDefault
  )
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo (..))
import Distribution.Simple.Program.ResponseFile
  ( withResponseFile
  )
import Distribution.Simple.Program.Run
  ( ProgramInvocation
  , multiStageProgramInvocation
  , programInvocation
  , runProgramInvocation
  )
import Distribution.Simple.Program.Types
  ( ConfiguredProgram (..)
  )
import Distribution.Simple.Setup.Config
  ( 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