module GHC.Linker.Static
   ( linkStaticLib
   )
where

import GHC.Prelude
import GHC.Platform
import GHC.Settings

import GHC.SysTools
import GHC.SysTools.Ar

import GHC.Unit.Env
import GHC.Unit.Types
import GHC.Unit.Info
import GHC.Unit.State

import GHC.Utils.Logger
import GHC.Utils.Monad

import GHC.Linker.Unit
import GHC.Linker.Static.Utils

import GHC.Driver.Session

import System.FilePath
import System.Directory
import Control.Monad

-----------------------------------------------------------------------------
-- Static linking, of .o files

-- The list of packages passed to link is the list of packages on
-- which this program depends, as discovered by the compilation
-- manager.  It is combined with the list of packages that the user
-- specifies on the command line with -package flags.
--
-- In one-shot linking mode, we can't discover the package
-- dependencies (because we haven't actually done any compilation or
-- read any interface files), so the user must explicitly specify all
-- the packages.

-- | Linking a static lib will not really link anything. It will merely produce
-- a static archive of all dependent static libraries. The resulting library
-- will still need to be linked with any remaining link flags.
linkStaticLib :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkStaticLib :: Logger -> DynFlags -> UnitEnv -> [String] -> [UnitId] -> IO ()
linkStaticLib Logger
logger DynFlags
dflags UnitEnv
unit_env [String]
o_files [UnitId]
dep_units = do
  let platform :: Platform
platform  = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
      extra_ld_inputs :: [String]
extra_ld_inputs = [ String
f | FileOption String
_ String
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
      modules :: [String]
modules = [String]
o_files [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_ld_inputs
      arch_os :: ArchOS
arch_os = Platform -> ArchOS
platformArchOS Platform
platform
      output_fn :: String
output_fn = ArchOS -> Bool -> Maybe String -> String
exeFileName ArchOS
arch_os Bool
True (DynFlags -> Maybe String
outputFile_ DynFlags
dflags)
      namever :: GhcNameVersion
namever = DynFlags -> GhcNameVersion
ghcNameVersion DynFlags
dflags
      ways_ :: Ways
ways_   = DynFlags -> Ways
ways DynFlags
dflags

  full_output_fn <- if String -> Bool
isAbsolute String
output_fn
                    then String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
output_fn
                    else do d <- IO String
getCurrentDirectory
                            return $ normalise (d </> output_fn)
  output_exists <- doesFileExist full_output_fn
  (when output_exists) $ removeFile full_output_fn

  pkg_cfgs_init <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)

  let pkg_cfgs
        | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_LinkRts DynFlags
dflags
        = [UnitInfo]
pkg_cfgs_init
        | Bool
otherwise
        = (UnitInfo -> Bool) -> [UnitInfo] -> [UnitInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
rtsUnitId) (UnitId -> Bool) -> (UnitInfo -> UnitId) -> UnitInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitInfo -> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId) [UnitInfo]
pkg_cfgs_init

  archives <- concatMapM (collectArchives namever ways_) pkg_cfgs

  ar <- foldl mappend
        <$> (Archive <$> mapM loadObj modules)
        <*> mapM loadAr archives

  if toolSettings_ldIsGnuLd (toolSettings dflags)
    then writeGNUAr output_fn $ afilter (not . isGNUSymdef) ar
    else writeBSDAr output_fn $ afilter (not . isBSDSymdef) ar

  -- run ranlib over the archive. write*Ar does *not* create the symbol index.
  let ranlib_opts = DynFlags -> RanlibConfig
configureRanlib DynFlags
dflags
  runRanlib logger ranlib_opts [GHC.SysTools.FileOption "" output_fn]