    module GHC.Linker.Static
       ( linkBinary
       , linkStaticLib
       )
    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.External
    import GHC.Linker.Windows
    import GHC.Linker.Static.Utils

    import GHC.Driver.Config.Linker
    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 = HasDebugCallStack => UnitEnv -> UnitState
    UnitEnv -> UnitState
    ue_homeUnitState UnitEnv
    unit_env
            toolSettings' :: ToolSettings
    toolSettings' = DynFlags -> ToolSettings
    toolSettings DynFlags
    dflags
            verbFlags :: [FilePath]
    verbFlags = DynFlags -> [FilePath]
    getVerbFlags DynFlags
    dflags
            arch_os :: ArchOS
    arch_os   = Platform -> ArchOS
    platformArchOS Platform
    platform
            output_fn :: FilePath
    output_fn = ArchOS -> Bool -> Maybe FilePath -> FilePath
    exeFileName ArchOS
    arch_os Bool
    staticLink (DynFlags -> Maybe FilePath
    outputFile_ DynFlags
    dflags)
            namever :: GhcNameVersion
    namever   = DynFlags -> GhcNameVersion
    ghcNameVersion DynFlags
    dflags
            -- For the wasm target, when ghc is invoked with -dynamic,
            -- when linking the final .wasm binary we must still ensure
            -- the static archives are selected. Otherwise wasm-ld would
            -- fail to find and link the .so library dependencies. wasm-ld
            -- can link PIC objects into static .wasm binaries fine, so we
            -- only adjust the ways in the final linking step, and only
            -- when linking .wasm binary (which is supposed to be fully
            -- static), not when linking .so shared libraries.
            ways_ :: Ways
    ways_
              | Arch
    ArchWasm32 <- Platform -> Arch
    platformArch Platform
    platform = Way -> Ways -> Ways
    removeWay Way
    WayDyn (Ways -> Ways) -> Ways -> Ways
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> Ways
    targetWays_ DynFlags
    dflags
              | Bool
    otherwise = DynFlags -> Ways
    ways DynFlags
    dflags

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

        -- 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.
        pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
        let pkg_lib_paths     = Ways -> [UnitInfo] -> [FilePath]
    collectLibraryDirs Ways
    ways_ [UnitInfo]
    pkgs
        let 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
    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
    &&
               Ways
    ways_ Ways -> Way -> Bool
    `hasWay` Way
    WayDyn
                = 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
    &&
               Ways
    ways_ Ways -> Way -> Bool
    `hasWay` Way
    WayDyn 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]

        pkg_lib_path_opts <-
          if gopt Opt_SingleLibFolder dflags
          then do
            libs <- getLibs namever ways_ unit_env dep_units
            tmpDir <- newTempSubDir logger tmpfs (tmpDir dflags)
            sequence_ [ copyFile lib (tmpDir </> basename)
                      | (lib, basename) <- libs]
            return [ "-L" ++ tmpDir ]
          else pure pkg_lib_path_opts

        let
          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 = DynFlags -> [FilePath]
    libraryPaths DynFlags
    dflags
        let 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

        extraLinkObj <- maybeToList <$> mkExtraObjToLinkIntoBinary logger tmpfs dflags unit_state
        noteLinkObjs <- mkNoteObjsToLinkIntoBinary logger tmpfs dflags unit_env dep_units

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

        pkg_link_opts <- do
            unit_link_opts <- getUnitLinkOpts namever ways_ unit_env dep_units
            return $ otherFlags unit_link_opts ++ dead_strip
                      ++ pre_hs_libs ++ hsLibs unit_link_opts ++ post_hs_libs
                      ++ extraLibs unit_link_opts
                     -- -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
        pkg_framework_opts <- getUnitFrameworkOpts unit_env dep_units
        let framework_opts = FrameworkOpts -> Platform -> [FilePath]
    getFrameworkOpts (DynFlags -> FrameworkOpts
    initFrameworkOpts DynFlags
    dflags) Platform
    platform

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

        rc_objs <- case platformOS 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

        let linker_config = DynFlags -> LinkerConfig
    initLinkerConfig DynFlags
    dflags
        let link DynFlags
    dflags [Option]
    args = do
              Logger -> TmpFs -> LinkerConfig -> [Option] -> IO ()
    runLink Logger
    logger TmpFs
    tmpfs LinkerConfig
    linker_config [Option]
    args
              -- Make sure to honour -fno-use-rpaths if set on darwin as well; see #20004
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Platform -> OS
    platformOS Platform
    platform OS -> OS -> Bool
    forall a. Eq a => a -> a -> Bool
    == OS
    OSDarwin Bool -> Bool -> Bool
    && GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_RPath DynFlags
    dflags) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Logger -> ToolSettings -> [FilePath] -> FilePath -> IO ()
    GHC.Linker.MacOS.runInjectRPaths Logger
    logger (DynFlags -> ToolSettings
    toolSettings DynFlags
    dflags) [FilePath]
    pkg_lib_paths FilePath
    output_fn

        link dflags (
                           map GHC.SysTools.Option verbFlags
                          ++ [ GHC.SysTools.Option "-o"
                             , GHC.SysTools.FileOption "" output_fn
                             ]
                          ++ libmLinkOpts platform
                          ++ map GHC.SysTools.Option (
                             []

                          -- See Note [No PIE when linking]
                          ++ pieCCLDOpts dflags

                          -- Permit the linker to auto link _symbol to _imp_symbol.
                          -- This lets us link against DLLs without needing an "import library".
                          ++ (if platformOS platform == OSMinGW32
                              then ["-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.
                          ++ (if not (gopt Opt_CompactUnwind dflags) &&
                                 toolSettings_ldSupportsCompactUnwind toolSettings' &&
                                 (platformOS platform == OSDarwin) &&
                                 case platformArch platform of
                                   Arch
    ArchX86_64  -> Bool
    True
                                   Arch
    ArchAArch64 -> Bool
    True
                                   Arch
    _ -> Bool
    False
                              then ["-Wl,-no_compact_unwind"]
                              else [])

                              -- We should rather be asking does it support --gc-sections?
                          ++ (if toolSettings_ldIsGnuLd toolSettings' &&
                                 not (gopt Opt_WholeArchiveHsLibs dflags)
                              then ["-Wl,--gc-sections"]
                              else [])

                          ++ o_files
                          ++ lib_path_opts)
                          ++ extra_ld_inputs
                          ++ map GHC.SysTools.Option (
                             rc_objs
                          ++ framework_opts
                          ++ pkg_lib_path_opts
                          ++ extraLinkObj
                          ++ noteLinkObjs
                          -- See Note [RTS/ghc-internal interface]
                          -- (-u<sym> must come before -lghc-internal...!)
                          ++ (if ghcInternalUnitId `elem` map unitId pkgs
                              then [concat [ "-Wl,-u,"
                                           , ['_' | platformLeadingUnderscore platform]
                                           , "init_ghc_hs_iface" ]]
                              else [])
                          ++ pkg_link_opts
                          ++ pkg_framework_opts
                          ++ (if platformOS platform == 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 [ "-Wl,-dead_strip_dylibs", "-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
          arch_os :: ArchOS
    arch_os = Platform -> ArchOS
    platformArchOS Platform
    platform
          output_fn :: FilePath
    output_fn = ArchOS -> Bool -> Maybe FilePath -> FilePath
    exeFileName ArchOS
    arch_os Bool
    True (DynFlags -> Maybe FilePath
    outputFile_ DynFlags
    dflags)
          namever :: GhcNameVersion
    namever = DynFlags -> GhcNameVersion
    ghcNameVersion DynFlags
    dflags
          ways_ :: Ways
    ways_   = DynFlags -> Ways
    ways DynFlags
    dflags

      full_output_fn <- if FilePath -> Bool
    isAbsolute FilePath
    output_fn
                        then FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    output_fn
                        else do d <- IO FilePath
    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.
      runRanlib logger dflags [GHC.SysTools.FileOption "" output_fn]