module GHC.Linker.Static
   ( linkBinary
   , linkBinary'
   , linkStaticLib
   , exeFileName
   )
where

import GHC.Prelude
import GHC.Platform
import GHC.Platform.Ways
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.Utils.Misc
import GHC.Utils.TmpFs

import GHC.Linker.MacOS
import GHC.Linker.Unit
import GHC.Linker.Dynamic
import GHC.Linker.ExtraObj
import GHC.Linker.Windows

import GHC.Driver.Session

import System.FilePath
import System.Directory
import Control.Monad
import Data.Maybe

-----------------------------------------------------------------------------
-- 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.

{-
Note [-Xlinker -rpath vs -Wl,-rpath]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-Wl takes a comma-separated list of options which in the case of
-Wl,-rpath -Wl,some,path,with,commas parses the path with commas
as separate options.
Buck, the build system, produces paths with commas in them.

-Xlinker doesn't have this disadvantage and as far as I can tell
it is supported by both gcc and clang. Anecdotally nvcc supports
-Xlinker, but not -Wl.
-}

linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary :: Logger
-> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary = Bool
-> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkBinary' Bool
False

linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
linkBinary' :: Bool
-> Logger
-> TmpFs
-> DynFlags
-> UnitEnv
-> [FilePath]
-> [UnitId]
-> IO ()
linkBinary' Bool
staticLink Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units = do
    let platform :: Platform
platform   = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
        unit_state :: UnitState
unit_state = UnitEnv -> UnitState
ue_units UnitEnv
unit_env
        toolSettings' :: ToolSettings
toolSettings' = DynFlags -> ToolSettings
toolSettings DynFlags
dflags
        verbFlags :: [FilePath]
verbFlags = DynFlags -> [FilePath]
getVerbFlags DynFlags
dflags
        output_fn :: FilePath
output_fn = Platform -> Bool -> Maybe FilePath -> FilePath
exeFileName Platform
platform Bool
staticLink (DynFlags -> Maybe FilePath
outputFile DynFlags
dflags)

    -- get the full list of packages to link with, by combining the
    -- explicit packages with the auto packages and all of their
    -- dependencies, and eliminating duplicates.

    FilePath
full_output_fn <- if FilePath -> Bool
isAbsolute FilePath
output_fn
                      then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
output_fn
                      else do FilePath
d <- IO FilePath
getCurrentDirectory
                              FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
normalise (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
output_fn)
    [UnitInfo]
pkgs <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
dep_units)
    let pkg_lib_paths :: [FilePath]
pkg_lib_paths     = Ways -> [UnitInfo] -> [FilePath]
collectLibraryDirs (DynFlags -> Ways
ways DynFlags
dflags) [UnitInfo]
pkgs
    let pkg_lib_path_opts :: [FilePath]
pkg_lib_path_opts = (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
get_pkg_lib_path_opts [FilePath]
pkg_lib_paths
        get_pkg_lib_path_opts :: FilePath -> [FilePath]
get_pkg_lib_path_opts FilePath
l
         | OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&&
           DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
           Way
WayDyn Way -> Ways -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> Ways
ways DynFlags
dflags
            = let libpath :: FilePath
libpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RelativeDynlibPaths DynFlags
dflags
                            then FilePath
"$ORIGIN" FilePath -> FilePath -> FilePath
</>
                                 (FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
                            else FilePath
l
                  -- See Note [-Xlinker -rpath vs -Wl,-rpath]
                  rpath :: [FilePath]
rpath = if DynFlags -> OS -> Bool
useXLinkerRPath DynFlags
dflags (Platform -> OS
platformOS Platform
platform)
                          then [FilePath
"-Xlinker", FilePath
"-rpath", FilePath
"-Xlinker", FilePath
libpath]
                          else []
                  -- Solaris 11's linker does not support -rpath-link option. It silently
                  -- ignores it and then complains about next option which is -l<some
                  -- dir> as being a directory and not expected object file, E.g
                  -- ld: elf error: file
                  -- /tmp/ghc-src/libraries/base/dist-install/build:
                  -- elf_begin: I/O error: region read: Is a directory
                  rpathlink :: [FilePath]
rpathlink = if (Platform -> OS
platformOS Platform
platform) OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSSolaris2
                              then []
                              else [FilePath
"-Xlinker", FilePath
"-rpath-link", FilePath
"-Xlinker", FilePath
l]
              in [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpathlink [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
rpath
         | OS -> Bool
osMachOTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&&
           DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
           Way
WayDyn Way -> Ways -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> Ways
ways DynFlags
dflags Bool -> Bool -> Bool
&&
           DynFlags -> OS -> Bool
useXLinkerRPath DynFlags
dflags (Platform -> OS
platformOS Platform
platform)
            = let libpath :: FilePath
libpath = if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RelativeDynlibPaths DynFlags
dflags
                            then FilePath
"@loader_path" FilePath -> FilePath -> FilePath
</>
                                 (FilePath
l FilePath -> FilePath -> FilePath
`makeRelativeTo` FilePath
full_output_fn)
                            else FilePath
l
              in [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-Xlinker", FilePath
"-rpath", FilePath
"-Xlinker", FilePath
libpath]
         | Bool
otherwise = [FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
l]

    [FilePath]
pkg_lib_path_opts <-
      if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SingleLibFolder DynFlags
dflags
      then do
        [(FilePath, FilePath)]
libs <- DynFlags -> UnitEnv -> [UnitId] -> IO [(FilePath, FilePath)]
getLibs DynFlags
dflags UnitEnv
unit_env [UnitId]
dep_units
        FilePath
tmpDir <- Logger -> TmpFs -> DynFlags -> IO FilePath
newTempDir Logger
logger TmpFs
tmpfs DynFlags
dflags
        [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FilePath -> FilePath -> IO ()
copyFile FilePath
lib (FilePath
tmpDir FilePath -> FilePath -> FilePath
</> FilePath
basename)
                  | (FilePath
lib, FilePath
basename) <- [(FilePath, FilePath)]
libs]
        [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tmpDir ]
      else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
pkg_lib_path_opts

    let
      dead_strip :: [FilePath]
dead_strip
        | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags = []
        | Bool
otherwise = if OS -> Bool
osSubsectionsViaSymbols (Platform -> OS
platformOS Platform
platform)
                        then [FilePath
"-Wl,-dead_strip"]
                        else []
    let lib_paths :: [FilePath]
lib_paths = DynFlags -> [FilePath]
libraryPaths DynFlags
dflags
    let lib_path_opts :: [FilePath]
lib_path_opts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-L"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
lib_paths

    [FilePath]
extraLinkObj <- Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList (Maybe FilePath -> [FilePath])
-> IO (Maybe FilePath) -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Logger -> TmpFs -> DynFlags -> UnitState -> IO (Maybe FilePath)
mkExtraObjToLinkIntoBinary Logger
logger TmpFs
tmpfs DynFlags
dflags UnitState
unit_state
    [FilePath]
noteLinkObjs <- Logger -> TmpFs -> DynFlags -> UnitEnv -> [UnitId] -> IO [FilePath]
mkNoteObjsToLinkIntoBinary Logger
logger TmpFs
tmpfs DynFlags
dflags UnitEnv
unit_env [UnitId]
dep_units

    let
      ([FilePath]
pre_hs_libs, [FilePath]
post_hs_libs)
        | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags
        = if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
            then ([FilePath
"-Wl,-all_load"], [])
              -- OS X does not have a flag to turn off -all_load
            else ([FilePath
"-Wl,--whole-archive"], [FilePath
"-Wl,--no-whole-archive"])
        | Bool
otherwise
        = ([],[])

    [FilePath]
pkg_link_opts <- do
        ([FilePath]
package_hs_libs, [FilePath]
extra_libs, [FilePath]
other_flags) <- DynFlags
-> UnitEnv -> [UnitId] -> IO ([FilePath], [FilePath], [FilePath])
getUnitLinkOpts DynFlags
dflags UnitEnv
unit_env [UnitId]
dep_units
        [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ if Bool
staticLink
            then [FilePath]
package_hs_libs -- If building an executable really means making a static
                                 -- library (e.g. iOS), then we only keep the -l options for
                                 -- HS packages, because libtool doesn't accept other options.
                                 -- In the case of iOS these need to be added by hand to the
                                 -- final link in Xcode.
            else [FilePath]
other_flags [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
dead_strip
                  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pre_hs_libs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
package_hs_libs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
post_hs_libs
                  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_libs
                 -- -Wl,-u,<sym> contained in other_flags
                 -- needs to be put before -l<package>,
                 -- otherwise Solaris linker fails linking
                 -- a binary with unresolved symbols in RTS
                 -- which are defined in base package
                 -- the reason for this is a note in ld(1) about
                 -- '-u' option: "The placement of this option
                 -- on the command line is significant.
                 -- This option must be placed before the library
                 -- that defines the symbol."

    -- frameworks
    [FilePath]
pkg_framework_opts <- UnitEnv -> [UnitId] -> IO [FilePath]
getUnitFrameworkOpts UnitEnv
unit_env [UnitId]
dep_units
    let framework_opts :: [FilePath]
framework_opts = DynFlags -> Platform -> [FilePath]
getFrameworkOpts DynFlags
dflags Platform
platform

        -- probably _stub.o files
    let extra_ld_inputs :: [Option]
extra_ld_inputs = DynFlags -> [Option]
ldInputs DynFlags
dflags

    [FilePath]
rc_objs <- case Platform -> OS
platformOS Platform
platform of
      OS
OSMinGW32 | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_GenManifest DynFlags
dflags -> Logger -> TmpFs -> DynFlags -> FilePath -> IO [FilePath]
maybeCreateManifest Logger
logger TmpFs
tmpfs DynFlags
dflags FilePath
output_fn
      OS
_                                       -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    let link :: DynFlags -> [Option] -> IO ()
link DynFlags
dflags [Option]
args | Bool
staticLink = Logger -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLibtool Logger
logger DynFlags
dflags [Option]
args
                         | Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
                            = do
                                 Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLink Logger
logger TmpFs
tmpfs DynFlags
dflags [Option]
args
                                 Logger -> DynFlags -> [FilePath] -> FilePath -> IO ()
GHC.Linker.MacOS.runInjectRPaths Logger
logger DynFlags
dflags [FilePath]
pkg_lib_paths FilePath
output_fn
                         | Bool
otherwise
                            = Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
GHC.SysTools.runLink Logger
logger TmpFs
tmpfs DynFlags
dflags [Option]
args

    DynFlags -> [Option] -> IO ()
link DynFlags
dflags (
                       (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option [FilePath]
verbFlags
                      [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ FilePath -> Option
GHC.SysTools.Option FilePath
"-o"
                         , FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn
                         ]
                      [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
libmLinkOpts
                      [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option (
                         []

                      -- See Note [No PIE when linking]
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ DynFlags -> [FilePath]
picCCOpts DynFlags
dflags

                      -- Permit the linker to auto link _symbol to _imp_symbol.
                      -- This lets us link against DLLs without needing an "import library".
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
                          then [FilePath
"-Wl,--enable-auto-import"]
                          else [])

                      -- '-no_compact_unwind'
                      -- C++/Objective-C exceptions cannot use optimised
                      -- stack unwinding code. The optimised form is the
                      -- default in Xcode 4 on at least x86_64, and
                      -- without this flag we're also seeing warnings
                      -- like
                      --     ld: warning: could not create compact unwind for .LFB3: non-standard register 5 being saved in prolog
                      -- on x86.
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_CompactUnwind DynFlags
dflags) Bool -> Bool -> Bool
&&
                             ToolSettings -> Bool
toolSettings_ldSupportsCompactUnwind ToolSettings
toolSettings' Bool -> Bool -> Bool
&&
                             Bool -> Bool
not Bool
staticLink Bool -> Bool -> Bool
&&
                             (Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin) Bool -> Bool -> Bool
&&
                             case Platform -> Arch
platformArch Platform
platform of
                               Arch
ArchX86     -> Bool
True
                               Arch
ArchX86_64  -> Bool
True
                               ArchARM {}  -> Bool
True
                               Arch
ArchAArch64 -> Bool
True
                               Arch
_ -> Bool
False
                          then [FilePath
"-Wl,-no_compact_unwind"]
                          else [])

                      -- '-Wl,-read_only_relocs,suppress'
                      -- ld gives loads of warnings like:
                      --     ld: warning: text reloc in _base_GHCziArr_unsafeArray_info to _base_GHCziArr_unsafeArray_closure
                      -- when linking any program. We're not sure
                      -- whether this is something we ought to fix, but
                      -- for now this flags silences them.
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Platform -> OS
platformOS   Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin Bool -> Bool -> Bool
&&
                             Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86 Bool -> Bool -> Bool
&&
                             Bool -> Bool
not Bool
staticLink
                          then [FilePath
"-Wl,-read_only_relocs,suppress"]
                          else [])

                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if ToolSettings -> Bool
toolSettings_ldIsGnuLd ToolSettings
toolSettings' Bool -> Bool -> Bool
&&
                             Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WholeArchiveHsLibs DynFlags
dflags)
                          then [FilePath
"-Wl,--gc-sections"]
                          else [])

                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
o_files
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
lib_path_opts)
                      [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
                      [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
GHC.SysTools.Option (
                         [FilePath]
rc_objs
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
framework_opts
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_lib_path_opts
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extraLinkObj
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
noteLinkObjs
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_link_opts
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
pkg_framework_opts
                      [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
                          --  dead_strip_dylibs, will remove unused dylibs, and thus save
                          --  space in the load commands. The -headerpad is necessary so
                          --  that we can inject more @rpath's later for the left over
                          --  libraries during runInjectRpaths phase.
                          --
                          --  See Note [Dynamic linking on macOS].
                          then [ FilePath
"-Wl,-dead_strip_dylibs", FilePath
"-Wl,-headerpad,8000" ]
                          else [])
                    ))

-- | 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 -> [FilePath] -> [UnitId] -> IO ()
linkStaticLib Logger
logger DynFlags
dflags UnitEnv
unit_env [FilePath]
o_files [UnitId]
dep_units = do
  let platform :: Platform
platform  = UnitEnv -> Platform
ue_platform UnitEnv
unit_env
      extra_ld_inputs :: [FilePath]
extra_ld_inputs = [ FilePath
f | FileOption FilePath
_ FilePath
f <- DynFlags -> [Option]
ldInputs DynFlags
dflags ]
      modules :: [FilePath]
modules = [FilePath]
o_files [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
extra_ld_inputs
      output_fn :: FilePath
output_fn = Platform -> Bool -> Maybe FilePath -> FilePath
exeFileName Platform
platform Bool
True (DynFlags -> Maybe FilePath
outputFile DynFlags
dflags)

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

  [UnitInfo]
pkg_cfgs_init <- MaybeErr UnitErr [UnitInfo] -> IO [UnitInfo]
forall a. MaybeErr UnitErr a -> IO a
mayThrowUnitErr (UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
preloadUnitsInfo' UnitEnv
unit_env [UnitId]
dep_units)

  let pkg_cfgs :: [UnitInfo]
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 compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId) [UnitInfo]
pkg_cfgs_init

  [FilePath]
archives <- (UnitInfo -> IO [FilePath]) -> [UnitInfo] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (DynFlags -> UnitInfo -> IO [FilePath]
collectArchives DynFlags
dflags) [UnitInfo]
pkg_cfgs

  Archive
ar <- (Archive -> Archive -> Archive) -> Archive -> [Archive] -> Archive
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Archive -> Archive -> Archive
forall a. Monoid a => a -> a -> a
mappend
        (Archive -> [Archive] -> Archive)
-> IO Archive -> IO ([Archive] -> Archive)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ArchiveEntry] -> Archive
Archive ([ArchiveEntry] -> Archive) -> IO [ArchiveEntry] -> IO Archive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO ArchiveEntry) -> [FilePath] -> IO [ArchiveEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO ArchiveEntry
loadObj [FilePath]
modules)
        IO ([Archive] -> Archive) -> IO [Archive] -> IO Archive
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> IO Archive) -> [FilePath] -> IO [Archive]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Archive
loadAr [FilePath]
archives

  if ToolSettings -> Bool
toolSettings_ldIsGnuLd (DynFlags -> ToolSettings
toolSettings DynFlags
dflags)
    then FilePath -> Archive -> IO ()
writeGNUAr FilePath
output_fn (Archive -> IO ()) -> Archive -> IO ()
forall a b. (a -> b) -> a -> b
$ (ArchiveEntry -> Bool) -> Archive -> Archive
afilter (Bool -> Bool
not (Bool -> Bool) -> (ArchiveEntry -> Bool) -> ArchiveEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveEntry -> Bool
isGNUSymdef) Archive
ar
    else FilePath -> Archive -> IO ()
writeBSDAr FilePath
output_fn (Archive -> IO ()) -> Archive -> IO ()
forall a b. (a -> b) -> a -> b
$ (ArchiveEntry -> Bool) -> Archive -> Archive
afilter (Bool -> Bool
not (Bool -> Bool) -> (ArchiveEntry -> Bool) -> ArchiveEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveEntry -> Bool
isBSDSymdef) Archive
ar

  -- run ranlib over the archive. write*Ar does *not* create the symbol index.
  Logger -> DynFlags -> [Option] -> IO ()
runRanlib Logger
logger DynFlags
dflags [FilePath -> FilePath -> Option
GHC.SysTools.FileOption FilePath
"" FilePath
output_fn]



-- | Compute the output file name of a program.
--
-- StaticLink boolean is used to indicate if the program is actually a static library
-- (e.g., on iOS).
--
-- Use the provided filename (if any), otherwise use "main.exe" (Windows),
-- "a.out (otherwise without StaticLink set), "liba.a". In every case, add the
-- extension if it is missing.
exeFileName :: Platform -> Bool -> Maybe FilePath -> FilePath
exeFileName :: Platform -> Bool -> Maybe FilePath -> FilePath
exeFileName Platform
platform Bool
staticLink Maybe FilePath
output_fn
  | Just FilePath
s <- Maybe FilePath
output_fn =
      case Platform -> OS
platformOS Platform
platform of
          OS
OSMinGW32 -> FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"exe"
          OS
_         -> if Bool
staticLink
                         then FilePath
s FilePath -> FilePath -> FilePath
<?.> FilePath
"a"
                         else FilePath
s
  | Bool
otherwise =
      if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSMinGW32
      then FilePath
"main.exe"
      else if Bool
staticLink
           then FilePath
"liba.a"
           else FilePath
"a.out"
 where FilePath
s <?.> :: FilePath -> FilePath -> FilePath
<?.> FilePath
ext | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> FilePath
takeExtension FilePath
s) = FilePath
s FilePath -> FilePath -> FilePath
<.> FilePath
ext
                  | Bool
otherwise              = FilePath
s