    {-# LANGUAGE ScopedTypeVariables #-}
    -----------------------------------------------------------------------------
    --
    -- Compiler information functions
    --
    -- (c) The GHC Team 2017
    --
    -----------------------------------------------------------------------------
    module GHC.SysTools.Info where

    import GHC.Utils.Exception
    import GHC.Utils.Error
    import GHC.Driver.Session
    import GHC.Utils.Outputable
    import GHC.Utils.Misc

    import Data.List
    import Data.IORef

    import System.IO

    import GHC.Platform
    import GHC.Prelude

    import GHC.SysTools.Process

    {- Note [Run-time linker info]

    See also: #5240, #6063, #10110

    Before 'runLink', we need to be sure to get the relevant information
    about the linker we're using at runtime to see if we need any extra
    options. For example, GNU ld requires '--reduce-memory-overheads' and
    '--hash-size=31' in order to use reasonable amounts of memory (see
    trac #5240.) But this isn't supported in GNU gold.

    Generally, the linker changing from what was detected at ./configure
    time has always been possible using -pgml, but on Linux it can happen
    'transparently' by installing packages like binutils-gold, which
    change what /usr/bin/ld actually points to.

    Clang vs GCC notes:

    For gcc, 'gcc -Wl,--version' gives a bunch of output about how to
    invoke the linker before the version information string. For 'clang',
    the version information for 'ld' is all that's output. For this
    reason, we typically need to slurp up all of the standard error output
    and look through it.

    Other notes:

    We cache the LinkerInfo inside DynFlags, since clients may link
    multiple times. The definition of LinkerInfo is there to avoid a
    circular dependency.

    -}

    {- Note [ELF needed shared libs]

    Some distributions change the link editor's default handling of
    ELF DT_NEEDED tags to include only those shared objects that are
    needed to resolve undefined symbols. For Template Haskell we need
    the last temporary shared library also if it is not needed for the
    currently linked temporary shared library. We specify --no-as-needed
    to override the default. This flag exists in GNU ld and GNU gold.

    The flag is only needed on ELF systems. On Windows (PE) and Mac OS X
    (Mach-O) the flag is not needed.

    -}

    {- Note [Windows static libGCC]

    The GCC versions being upgraded to in #10726 are configured with
    dynamic linking of libgcc supported. This results in libgcc being
    linked dynamically when a shared library is created.

    This introduces thus an extra dependency on GCC dll that was not
    needed before by shared libraries created with GHC. This is a particular
    issue on Windows because you get a non-obvious error due to this missing
    dependency. This dependent dll is also not commonly on your path.

    For this reason using the static libgcc is preferred as it preserves
    the same behaviour that existed before. There are however some very good
    reasons to have the shared version as well as described on page 181 of
    https://gcc.gnu.org/onlinedocs/gcc-5.2.0/gcc.pdf :

    "There are several situations in which an application should use the
     shared ‘libgcc’ instead of the static version. The most common of these
     is when the application wishes to throw and catch exceptions across different
     shared libraries. In that case, each of the libraries as well as the application
     itself should use the shared ‘libgcc’. "

    -}

    neededLinkArgs :: LinkerInfo -> [Option]
    neededLinkArgs :: LinkerInfo -> [Option]
    neededLinkArgs (GnuLD [Option]
    o)     = [Option]
    o
    neededLinkArgs (GnuGold [Option]
    o)   = [Option]
    o
    neededLinkArgs (LlvmLLD [Option]
    o)   = [Option]
    o
    neededLinkArgs (DarwinLD [Option]
    o)  = [Option]
    o
    neededLinkArgs (SolarisLD [Option]
    o) = [Option]
    o
    neededLinkArgs (AixLD [Option]
    o)     = [Option]
    o
    neededLinkArgs LinkerInfo
    UnknownLD     = []

    -- Grab linker info and cache it in DynFlags.
    getLinkerInfo :: DynFlags -> IO LinkerInfo
    getLinkerInfo :: DynFlags -> IO LinkerInfo
    getLinkerInfo DynFlags
    dflags = do
      Maybe LinkerInfo
    info <- IORef (Maybe LinkerInfo) -> IO (Maybe LinkerInfo)
    forall a. IORef a -> IO a
    readIORef (DynFlags -> IORef (Maybe LinkerInfo)
    rtldInfo DynFlags
    dflags)
      case Maybe LinkerInfo
    info of
        Just LinkerInfo
    v  -> LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return LinkerInfo
    v
        Maybe LinkerInfo
    Nothing -> do
          LinkerInfo
    v <- DynFlags -> IO LinkerInfo
    getLinkerInfo' DynFlags
    dflags
          IORef (Maybe LinkerInfo) -> Maybe LinkerInfo -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (DynFlags -> IORef (Maybe LinkerInfo)
    rtldInfo DynFlags
    dflags) (LinkerInfo -> Maybe LinkerInfo
    forall a. a -> Maybe a
    Just LinkerInfo
    v)
          LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return LinkerInfo
    v

    -- See Note [Run-time linker info].
    getLinkerInfo' :: DynFlags -> IO LinkerInfo
    getLinkerInfo' :: DynFlags -> IO LinkerInfo
    getLinkerInfo' DynFlags
    dflags = do
      let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
          os :: OS
    os = Platform -> OS
    platformOS Platform
    platform
          (String
    pgm,[Option]
    args0) = DynFlags -> (String, [Option])
    pgm_l DynFlags
    dflags
          args1 :: [Option]
    args1     = (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option (DynFlags -> (DynFlags -> [String]) -> [String]
    forall a. DynFlags -> (DynFlags -> [a]) -> [a]
    getOpts DynFlags
    dflags DynFlags -> [String]
    opt_l)
          args2 :: [Option]
    args2     = [Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1
          args3 :: [String]
    args3     = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    forall a. [a] -> Bool
    notNull ((Option -> String) -> [Option] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Option -> String
    showOpt [Option]
    args2)

          -- Try to grab the info from the process output.
          parseLinkerInfo :: t String -> p -> p -> m LinkerInfo
    parseLinkerInfo t String
    stdo p
    _stde p
    _exitc
            | (String -> Bool) -> t String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "GNU ld" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) t String
    stdo =
              -- GNU ld specifically needs to use less memory. This especially
              -- hurts on small object files. #5240.
              -- Set DT_NEEDED for all shared libraries. #10110.
              -- TODO: Investigate if these help or hurt when using split sections.
              LinkerInfo -> m LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Option] -> LinkerInfo
    GnuLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option [String
    "-Wl,--hash-size=31",
                                          String
    "-Wl,--reduce-memory-overheads",
                                          -- ELF specific flag
                                          -- see Note [ELF needed shared libs]
                                          String
    "-Wl,--no-as-needed"])

            | (String -> Bool) -> t String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "GNU gold" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) t String
    stdo =
              -- GNU gold only needs --no-as-needed. #10110.
              -- ELF specific flag, see Note [ELF needed shared libs]
              LinkerInfo -> m LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Option] -> LinkerInfo
    GnuGold [String -> Option
    Option String
    "-Wl,--no-as-needed"])

            | (String -> Bool) -> t String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "LLD" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) t String
    stdo =
              LinkerInfo -> m LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Option] -> LinkerInfo
    LlvmLLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option [
                                          -- see Note [ELF needed shared libs]
                                          String
    "-Wl,--no-as-needed"])

             -- Unknown linker.
            | Bool
    otherwise = String -> m LinkerInfo
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "invalid --version output, or linker is unsupported"

      -- Process the executable call
      LinkerInfo
    info <- IO LinkerInfo -> (IOException -> IO LinkerInfo) -> IO LinkerInfo
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO (do
                 case OS
    os of
                   OS
    OSSolaris2 ->
                     -- Solaris uses its own Solaris linker. Even all
                     -- GNU C are recommended to configure with Solaris
                     -- linker instead of using GNU binutils linker. Also
                     -- all GCC distributed with Solaris follows this rule
                     -- precisely so we assume here, the Solaris linker is
                     -- used.
                     LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ [Option] -> LinkerInfo
    SolarisLD []
                   OS
    OSAIX ->
                     -- IBM AIX uses its own non-binutils linker as well
                     LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ [Option] -> LinkerInfo
    AixLD []
                   OS
    OSDarwin ->
                     -- Darwin has neither GNU Gold or GNU LD, but a strange linker
                     -- that doesn't support --version. We can just assume that's
                     -- what we're using.
                     LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ [Option] -> LinkerInfo
    DarwinLD []
                   OS
    OSMinGW32 ->
                     -- GHC doesn't support anything but GNU ld on Windows anyway.
                     -- Process creation is also fairly expensive on win32, so
                     -- we short-circuit here.
                     LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ [Option] -> LinkerInfo
    GnuLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
    forall a b. (a -> b) -> a -> b
    $ (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option
                       [ -- Reduce ld memory usage
                         String
    "-Wl,--hash-size=31"
                       , String
    "-Wl,--reduce-memory-overheads"
                         -- Emit gcc stack checks
                         -- Note [Windows stack usage]
                       , String
    "-fstack-check"
                         -- Force static linking of libGCC
                         -- Note [Windows static libGCC]
                       , String
    "-static-libgcc" ]
                   OS
    _ -> do
                     -- In practice, we use the compiler as the linker here. Pass
                     -- -Wl,--version to get linker version info.
                     (ExitCode
    exitc, String
    stdo, String
    stde) <- String
    -> [String] -> (String, String) -> IO (ExitCode, String, String)
    readProcessEnvWithExitCode String
    pgm
                                            ([String
    "-Wl,--version"] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    args3)
                                            (String, String)
    c_locale_env
                     -- Split the output by lines to make certain kinds
                     -- of processing easier. In particular, 'clang' and 'gcc'
                     -- have slightly different outputs for '-Wl,--version', but
                     -- it's still easy to figure out.
                     [String] -> [String] -> ExitCode -> IO LinkerInfo
    forall {t :: * -> *} {m :: * -> *} {p} {p}.
    (Foldable t, MonadFail m) =>
    t String -> p -> p -> m LinkerInfo
    parseLinkerInfo (String -> [String]
    lines String
    stdo) (String -> [String]
    lines String
    stde) ExitCode
    exitc
                )
                (\IOException
    err -> do
                    DynFlags -> Int -> MsgDoc -> IO ()
    debugTraceMsg DynFlags
    dflags Int
    2
                        (String -> MsgDoc
    text String
    "Error (figuring out linker information):" MsgDoc -> MsgDoc -> MsgDoc
    <+>
                         String -> MsgDoc
    text (IOException -> String
    forall a. Show a => a -> String
    show IOException
    err))
                    DynFlags -> MsgDoc -> IO ()
    errorMsg DynFlags
    dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Warning:") Int
    9 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
    forall a b. (a -> b) -> a -> b
    $
                      String -> MsgDoc
    text String
    "Couldn't figure out linker information!" MsgDoc -> MsgDoc -> MsgDoc
    $$
                      String -> MsgDoc
    text String
    "Make sure you're using GNU ld, GNU gold" MsgDoc -> MsgDoc -> MsgDoc
    <+>
                      String -> MsgDoc
    text String
    "or the built in OS X linker, etc."
                    LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return LinkerInfo
    UnknownLD)
      LinkerInfo -> IO LinkerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return LinkerInfo
    info

    -- Grab compiler info and cache it in DynFlags.
    getCompilerInfo :: DynFlags -> IO CompilerInfo
    getCompilerInfo :: DynFlags -> IO CompilerInfo
    getCompilerInfo DynFlags
    dflags = do
      Maybe CompilerInfo
    info <- IORef (Maybe CompilerInfo) -> IO (Maybe CompilerInfo)
    forall a. IORef a -> IO a
    readIORef (DynFlags -> IORef (Maybe CompilerInfo)
    rtccInfo DynFlags
    dflags)
      case Maybe CompilerInfo
    info of
        Just CompilerInfo
    v  -> CompilerInfo -> IO CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    v
        Maybe CompilerInfo
    Nothing -> do
          CompilerInfo
    v <- DynFlags -> IO CompilerInfo
    getCompilerInfo' DynFlags
    dflags
          IORef (Maybe CompilerInfo) -> Maybe CompilerInfo -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (DynFlags -> IORef (Maybe CompilerInfo)
    rtccInfo DynFlags
    dflags) (CompilerInfo -> Maybe CompilerInfo
    forall a. a -> Maybe a
    Just CompilerInfo
    v)
          CompilerInfo -> IO CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    v

    -- See Note [Run-time linker info].
    getCompilerInfo' :: DynFlags -> IO CompilerInfo
    getCompilerInfo' :: DynFlags -> IO CompilerInfo
    getCompilerInfo' DynFlags
    dflags = do
      let pgm :: String
    pgm = DynFlags -> String
    pgm_c DynFlags
    dflags
          -- Try to grab the info from the process output.
          parseCompilerInfo :: p -> [String] -> p -> m CompilerInfo
    parseCompilerInfo p
    _stdo [String]
    stde p
    _exitc
            -- Regular GCC
            | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "gcc version" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`) [String]
    stde =
              CompilerInfo -> m CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    GCC
            -- Regular clang
            | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "clang version" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`) [String]
    stde =
              CompilerInfo -> m CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    Clang
            -- FreeBSD clang
            | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "FreeBSD clang version" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf`) [String]
    stde =
              CompilerInfo -> m CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    Clang
            -- Xcode 5.1 clang
            | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "Apple LLVM version 5.1" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    stde =
              CompilerInfo -> m CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    AppleClang51
            -- Xcode 5 clang
            | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "Apple LLVM version" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    stde =
              CompilerInfo -> m CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    AppleClang
            -- Xcode 4.1 clang
            | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    "Apple clang version" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    stde =
              CompilerInfo -> m CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    AppleClang
             -- Unknown linker.
            | Bool
    otherwise = String -> m CompilerInfo
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m CompilerInfo) -> String -> m CompilerInfo
    forall a b. (a -> b) -> a -> b
    $ String
    "invalid -v output, or compiler is unsupported: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines [String]
    stde

      -- Process the executable call
      CompilerInfo
    info <- IO CompilerInfo
    -> (IOException -> IO CompilerInfo) -> IO CompilerInfo
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO (do
                    (ExitCode
    exitc, String
    stdo, String
    stde) <-
                        String
    -> [String] -> (String, String) -> IO (ExitCode, String, String)
    readProcessEnvWithExitCode String
    pgm [String
    "-v"] (String, String)
    c_locale_env
                    -- Split the output by lines to make certain kinds
                    -- of processing easier.
                    [String] -> [String] -> ExitCode -> IO CompilerInfo
    forall {m :: * -> *} {p} {p}.
    MonadFail m =>
    p -> [String] -> p -> m CompilerInfo
    parseCompilerInfo (String -> [String]
    lines String
    stdo) (String -> [String]
    lines String
    stde) ExitCode
    exitc
                )
                (\IOException
    err -> do
                    DynFlags -> Int -> MsgDoc -> IO ()
    debugTraceMsg DynFlags
    dflags Int
    2
                        (String -> MsgDoc
    text String
    "Error (figuring out C compiler information):" MsgDoc -> MsgDoc -> MsgDoc
    <+>
                         String -> MsgDoc
    text (IOException -> String
    forall a. Show a => a -> String
    show IOException
    err))
                    DynFlags -> MsgDoc -> IO ()
    errorMsg DynFlags
    dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MsgDoc -> Int -> MsgDoc -> MsgDoc
    hang (String -> MsgDoc
    text String
    "Warning:") Int
    9 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
    forall a b. (a -> b) -> a -> b
    $
                      String -> MsgDoc
    text String
    "Couldn't figure out C compiler information!" MsgDoc -> MsgDoc -> MsgDoc
    $$
                      String -> MsgDoc
    text String
    "Make sure you're using GNU gcc, or clang"
                    CompilerInfo -> IO CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    UnknownCC)
      CompilerInfo -> IO CompilerInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return CompilerInfo
    info