    {-# LANGUAGE ScopedTypeVariables #-}

    -----------------------------------------------------------------------------
    --
    -- Tasks running external programs for SysTools
    --
    -- (c) The GHC Team 2017
    --
    -----------------------------------------------------------------------------
    module GHC.SysTools.Tasks where

    import GHC.Prelude
    import GHC.ForeignSrcLang

    import GHC.CmmToLlvm.Version (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound)

    import GHC.Settings

    import GHC.SysTools.Process

    import GHC.Driver.Session

    import GHC.Utils.Exception as Exception
    import GHC.Utils.Error
    import GHC.Utils.Outputable
    import GHC.Utils.Misc
    import GHC.Utils.Logger
    import GHC.Utils.TmpFs
    import GHC.Utils.Panic

    import Data.List (tails, isPrefixOf)
    import Data.Maybe (fromMaybe)
    import System.IO
    import System.Process

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Running an external program}
    *                                                                      *
    ************************************************************************
    -}

    runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
    runUnlit :: Logger -> DynFlags -> [Option] -> IO ()
    runUnlit Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "unlit" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let prog :: String
    prog = DynFlags -> String
    pgm_L DynFlags
    dflags
          opts :: [String]
    opts = DynFlags -> (DynFlags -> [String]) -> [String]
    forall a. DynFlags -> (DynFlags -> [a]) -> [a]
    getOpts DynFlags
    dflags DynFlags -> [String]
    opt_L
      Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "Literate pre-processor" String
    prog
                   ((String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option [String]
    opts [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args)

    -- | Prepend the working directory to the search path.
    -- Note [Filepaths and Multiple Home Units]
    augmentImports :: DynFlags  -> [FilePath] -> [FilePath]
    augmentImports :: DynFlags -> [String] -> [String]
    augmentImports DynFlags
    dflags [String]
    fps | Maybe String
    Nothing <- DynFlags -> Maybe String
    workingDirectory DynFlags
    dflags  = [String]
    fps
    augmentImports DynFlags
    _ [] = []
    augmentImports DynFlags
    _ [String
    x] = [String
    x]
    augmentImports DynFlags
    dflags (String
    "-include":String
    fp:[String]
    fps) = String
    "-include" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : DynFlags -> String -> String
    augmentByWorkingDirectory DynFlags
    dflags String
    fp  String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : DynFlags -> [String] -> [String]
    augmentImports DynFlags
    dflags [String]
    fps
    augmentImports DynFlags
    dflags (String
    fp1: String
    fp2: [String]
    fps) = String
    fp1 String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : DynFlags -> [String] -> [String]
    augmentImports DynFlags
    dflags (String
    fp2String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    fps)

    -- | Discard some harmless warnings from gcc that we can't turn off
    cc_filter :: String -> String
    cc_filter :: String -> String
    cc_filter = [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    doFilter ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines where
      {-
      gcc gives warnings in chunks like so:
          In file included from /foo/bar/baz.h:11,
                           from /foo/bar/baz2.h:22,
                           from wibble.c:33:
          /foo/flibble:14: global register variable ...
          /foo/flibble:15: warning: call-clobbered r...
      We break it up into its chunks, remove any call-clobbered register
      warnings from each chunk, and then delete any chunks that we have
      emptied of warnings.
      -}
      doFilter :: [String] -> [String]
    doFilter = [([String], [String])] -> [String]
    unChunkWarnings ([([String], [String])] -> [String])
    -> ([String] -> [([String], [String])]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [([String], [String])] -> [([String], [String])]
    filterWarnings ([([String], [String])] -> [([String], [String])])
    -> ([String] -> [([String], [String])])
    -> [String]
    -> [([String], [String])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String] -> [([String], [String])]
    chunkWarnings []
      -- We can't assume that the output will start with an "In file inc..."
      -- line, so we start off expecting a list of warnings rather than a
      -- location stack.
      chunkWarnings :: [String] -- The location stack to use for the next
                                -- list of warnings
                    -> [String] -- The remaining lines to look at
                    -> [([String], [String])]
      chunkWarnings :: [String] -> [String] -> [([String], [String])]
    chunkWarnings [String]
    loc_stack [] = [([String]
    loc_stack, [])]
      chunkWarnings [String]
    loc_stack [String]
    xs
          = case (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break String -> Bool
    loc_stack_start [String]
    xs of
            ([String]
    warnings, String
    lss:[String]
    xs') ->
                case (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span String -> Bool
    loc_start_continuation [String]
    xs' of
                ([String]
    lsc, [String]
    xs'') ->
                    ([String]
    loc_stack, [String]
    warnings) ([String], [String])
    -> [([String], [String])] -> [([String], [String])]
    forall a. a -> [a] -> [a]
    : [String] -> [String] -> [([String], [String])]
    chunkWarnings (String
    lss String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    lsc) [String]
    xs''
            ([String], [String])
    _ -> [([String]
    loc_stack, [String]
    xs)]

      filterWarnings :: [([String], [String])] -> [([String], [String])]
      filterWarnings :: [([String], [String])] -> [([String], [String])]
    filterWarnings [] = []
      -- If the warnings are already empty then we are probably doing
      -- something wrong, so don't delete anything
      filterWarnings (([String]
    xs, []) : [([String], [String])]
    zs) = ([String]
    xs, []) ([String], [String])
    -> [([String], [String])] -> [([String], [String])]
    forall a. a -> [a] -> [a]
    : [([String], [String])] -> [([String], [String])]
    filterWarnings [([String], [String])]
    zs
      filterWarnings (([String]
    xs, [String]
    ys) : [([String], [String])]
    zs) = case (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    wantedWarning [String]
    ys of
                                           [] -> [([String], [String])] -> [([String], [String])]
    filterWarnings [([String], [String])]
    zs
                                           [String]
    ys' -> ([String]
    xs, [String]
    ys') ([String], [String])
    -> [([String], [String])] -> [([String], [String])]
    forall a. a -> [a] -> [a]
    : [([String], [String])] -> [([String], [String])]
    filterWarnings [([String], [String])]
    zs

      unChunkWarnings :: [([String], [String])] -> [String]
      unChunkWarnings :: [([String], [String])] -> [String]
    unChunkWarnings [] = []
      unChunkWarnings (([String]
    xs, [String]
    ys) : [([String], [String])]
    zs) = [String]
    xs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    ys [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [([String], [String])] -> [String]
    unChunkWarnings [([String], [String])]
    zs

      loc_stack_start :: String -> Bool
    loc_stack_start        String
    s = String
    "In file included from " String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s
      loc_start_continuation :: String -> Bool
    loc_start_continuation String
    s = String
    "                 from " String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    s
      wantedWarning :: String -> Bool
    wantedWarning String
    w
       | String
    "warning: call-clobbered register used" String -> String -> Bool
    `isContainedIn` String
    w = Bool
    False
       | Bool
    otherwise = Bool
    True

    -- | See the Note [Preprocessing invocations]
    data SourceCodePreprocessor
      = SCPCpp
        -- ^ Use the ordinary C preprocessor
      | SCPHsCpp
        -- ^ Use the Haskell C preprocessor (don't remove C comments, don't break on names including single quotes)
      | SCPJsCpp
        -- ^ Use the JavaScript preprocessor (don't remove jsdoc and multiline comments)
      | SCPCmmCpp
        -- ^ Use the C-- preprocessor (don't emit debug information)
      deriving (SourceCodePreprocessor -> SourceCodePreprocessor -> Bool
    (SourceCodePreprocessor -> SourceCodePreprocessor -> Bool)
    -> (SourceCodePreprocessor -> SourceCodePreprocessor -> Bool)
    -> Eq SourceCodePreprocessor
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SourceCodePreprocessor -> SourceCodePreprocessor -> Bool
    == :: SourceCodePreprocessor -> SourceCodePreprocessor -> Bool
    $c/= :: SourceCodePreprocessor -> SourceCodePreprocessor -> Bool
    /= :: SourceCodePreprocessor -> SourceCodePreprocessor -> Bool
    Eq)

    -- | Run source code preprocessor.
    -- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp
    runSourceCodePreprocessor
      :: Logger
      -> TmpFs
      -> DynFlags
      -> SourceCodePreprocessor
      -> [Option]
      -> IO ()
    runSourceCodePreprocessor :: Logger
    -> TmpFs -> DynFlags -> SourceCodePreprocessor -> [Option] -> IO ()
    runSourceCodePreprocessor Logger
    logger TmpFs
    tmpfs DynFlags
    dflags SourceCodePreprocessor
    preprocessor [Option]
    args =
      Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    logger_name (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let
          (String
    p, [Option]
    args0) = DynFlags -> (String, [Option])
    pgm_getter DynFlags
    dflags
          args1 :: [Option]
    args1 = String -> Option
    Option (String -> Option) -> [String] -> [Option]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (DynFlags -> [String] -> [String]
    augmentImports DynFlags
    dflags ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> (DynFlags -> [String]) -> [String]
    forall a. DynFlags -> (DynFlags -> [a]) -> [a]
    getOpts DynFlags
    dflags DynFlags -> [String]
    opt_getter)
          args2 :: [Option]
    args2 = [String -> Option
    Option String
    "-Werror" | GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WarnIsError DynFlags
    dflags]
                    [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [String -> Option
    Option String
    "-Wundef" | WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnCPPUndef DynFlags
    dflags]
          all_args :: [Option]
    all_args = [Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args2 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args

        mb_env <- [Option] -> IO (Maybe [(String, String)])
    getGccEnv ([Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1)

        runSomething readable_name p all_args mb_env

      where
        toolSettings' :: ToolSettings
    toolSettings' = DynFlags -> ToolSettings
    toolSettings DynFlags
    dflags
        cmmG0 :: [String]
    cmmG0 = [String
    "-g0" | ToolSettings -> Bool
    toolSettings_cmmCppSupportsG0 ToolSettings
    toolSettings']
        -- GCC <=10 (pre commit r11-5596-g934a54180541d2) implied -dD for debug
        -- flags by the spec snippet %{g3|ggdb3|gstabs3|gxcoff3|gvms3:-dD}.  This
        -- means that a g0 will not override a previously-specified -g3 causing
        -- debug info emission (see https://gcc.gnu.org/PR97989).  We're filtering
        -- -optc here, rather than the combined command line, in order to avoid an
        -- issue where a user has to, for some reason, override our decision.  If
        -- they see the need to do that, they can pass -optCmmP.
        g3Flags :: [String]
    g3Flags = [String
    "-g3", String
    "-ggdb3", String
    "-gstabs3", String
    "-gxcoff3", String
    "-gvms3"]
        optCFiltered :: DynFlags -> [String]
    optCFiltered = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [String]
    g3Flags) ([String] -> [String])
    -> (DynFlags -> [String]) -> DynFlags -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynFlags -> [String]
    opt_c
        -- In the wild (and GHC), there is lots of code assuming that -optc gets
        -- passed to the C-- preprocessor too.  Note that the arguments are
        -- reversed by getOpts.
        cAndCmmOpt :: DynFlags -> [String]
    cAndCmmOpt DynFlags
    dflags =  DynFlags -> [String]
    opt_CmmP DynFlags
    dflags [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    cmmG0 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ DynFlags -> [String]
    optCFiltered DynFlags
    dflags
        (String
    logger_name, DynFlags -> (String, [Option])
    pgm_getter, DynFlags -> [String]
    opt_getter, String
    readable_name)
          = case SourceCodePreprocessor
    preprocessor of
            SourceCodePreprocessor
    SCPCpp -> (String
    "cpp", DynFlags -> (String, [Option])
    pgm_cpp, DynFlags -> [String]
    opt_c, String
    "C pre-processor")
            SourceCodePreprocessor
    SCPHsCpp -> (String
    "hs-cpp", DynFlags -> (String, [Option])
    pgm_P, DynFlags -> [String]
    opt_P, String
    "Haskell C pre-processor")
            SourceCodePreprocessor
    SCPJsCpp -> (String
    "js-cpp", DynFlags -> (String, [Option])
    pgm_JSP, DynFlags -> [String]
    opt_JSP, String
    "JavaScript C pre-processor")
            SourceCodePreprocessor
    SCPCmmCpp -> (String
    "cmm-cpp", DynFlags -> (String, [Option])
    pgm_CmmP, DynFlags -> [String]
    cAndCmmOpt, String
    "C-- C pre-processor")

        runSomethingResponseFileCpp :: String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomethingResponseFileCpp
          = Logger
    -> TmpFs
    -> TempDir
    -> (String -> String)
    -> String
    -> String
    -> [Option]
    -> Maybe [(String, String)]
    -> IO ()
    runSomethingResponseFile Logger
    logger TmpFs
    tmpfs (DynFlags -> TempDir
    tmpDir DynFlags
    dflags) String -> String
    cc_filter
        runSomethingFilteredOther :: String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomethingFilteredOther String
    phase_name String
    pgm [Option]
    args Maybe [(String, String)]
    mb_env
          = Logger
    -> (String -> String)
    -> String
    -> String
    -> [Option]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    runSomethingFiltered Logger
    logger String -> String
    forall a. a -> a
    id String
    phase_name String
    pgm [Option]
    args Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    mb_env

        runSomething :: String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomething
          = case SourceCodePreprocessor
    preprocessor of
            SourceCodePreprocessor
    SCPCpp -> String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomethingResponseFileCpp
            SourceCodePreprocessor
    SCPHsCpp -> String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomethingFilteredOther
            SourceCodePreprocessor
    SCPJsCpp -> String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomethingFilteredOther
            SourceCodePreprocessor
    SCPCmmCpp -> String -> String -> [Option] -> Maybe [(String, String)] -> IO ()
    runSomethingResponseFileCpp

    runPp :: Logger -> DynFlags -> [Option] -> IO ()
    runPp :: Logger -> DynFlags -> [Option] -> IO ()
    runPp Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "pp" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let prog :: String
    prog = DynFlags -> String
    pgm_F DynFlags
    dflags
          opts :: [Option]
    opts = (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_F)
      Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "Haskell pre-processor" String
    prog ([Option]
    args [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    opts)

    -- | Run compiler of C-like languages and raw objects (such as gcc or clang).
    runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
    runCc :: Maybe ForeignSrcLang
    -> Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
    runCc Maybe ForeignSrcLang
    mLanguage Logger
    logger TmpFs
    tmpfs DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "cc" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let args1 :: [Option]
    args1 = (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option [String]
    userOpts
          args2 :: [Option]
    args2 = [Option]
    languageOptions [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1
          -- We take care to pass -optc flags in args1 last to ensure that the
          -- user can override flags passed by GHC. See #14452.
      mb_env <- [Option] -> IO (Maybe [(String, String)])
    getGccEnv [Option]
    args2
      runSomethingResponseFile logger tmpfs (tmpDir dflags) cc_filter dbgstring prog args2
                               mb_env
     where
      -- force the C compiler to interpret this file as C when
      -- compiling .hc files, by adding the -x c option.
      -- Also useful for plain .c files, just in case GHC saw a
      -- -x c option.
      ([Option]
    languageOptions, [String]
    userOpts, String
    prog, String
    dbgstring) = case Maybe ForeignSrcLang
    mLanguage of
        Maybe ForeignSrcLang
    Nothing -> ([], [String]
    userOpts_c, DynFlags -> String
    pgm_c DynFlags
    dflags, String
    "C Compiler")
        Just ForeignSrcLang
    language -> ([String -> Option
    Option String
    "-x", String -> Option
    Option String
    languageName], [String]
    opts, String
    prog, String
    dbgstr)
          where
            (String
    languageName, [String]
    opts, String
    prog, String
    dbgstr) = case ForeignSrcLang
    language of
              ForeignSrcLang
    LangC      -> (String
    "c",             [String]
    userOpts_c
                            ,DynFlags -> String
    pgm_c DynFlags
    dflags,    String
    "C Compiler")
              ForeignSrcLang
    LangCxx    -> (String
    "c++",           [String]
    userOpts_cxx
                            ,DynFlags -> String
    pgm_cxx DynFlags
    dflags , String
    "C++ Compiler")
              ForeignSrcLang
    LangObjc   -> (String
    "objective-c",   [String]
    userOpts_c
                            ,DynFlags -> String
    pgm_c DynFlags
    dflags   , String
    "Objective C Compiler")
              ForeignSrcLang
    LangObjcxx -> (String
    "objective-c++", [String]
    userOpts_cxx
                            ,DynFlags -> String
    pgm_cxx DynFlags
    dflags,  String
    "Objective C++ Compiler")
              ForeignSrcLang
    LangAsm    -> (String
    "assembler",     []
                            ,DynFlags -> String
    pgm_c DynFlags
    dflags,    String
    "Asm Compiler")
              ForeignSrcLang
    RawObject  -> (String
    "c",             []
                            ,DynFlags -> String
    pgm_c DynFlags
    dflags,    String
    "C Compiler") -- claim C for lack of a better idea
              --JS backend shouldn't reach here, so we just pass
              -- strings to satisfy the totality checker
              ForeignSrcLang
    LangJs     -> (String
    "js",            []
                            ,DynFlags -> String
    pgm_c DynFlags
    dflags,    String
    "JS Backend Compiler")
      userOpts_c :: [String]
    userOpts_c   = DynFlags -> (DynFlags -> [String]) -> [String]
    forall a. DynFlags -> (DynFlags -> [a]) -> [a]
    getOpts DynFlags
    dflags DynFlags -> [String]
    opt_c
      userOpts_cxx :: [String]
    userOpts_cxx = DynFlags -> (DynFlags -> [String]) -> [String]
    forall a. DynFlags -> (DynFlags -> [a]) -> [a]
    getOpts DynFlags
    dflags DynFlags -> [String]
    opt_cxx

    isContainedIn :: String -> String -> Bool
    String
    xs isContainedIn :: String -> String -> Bool
    `isContainedIn` String
    ys = (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String
    xs String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) (String -> [String]
    forall a. [a] -> [[a]]
    tails String
    ys)

    -- | Run the linker with some arguments and return the output
    askLd :: Logger -> DynFlags -> [Option] -> IO String
    askLd :: Logger -> DynFlags -> [Option] -> IO String
    askLd Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO String -> IO String
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "linker" (IO String -> IO String) -> IO String -> IO String
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    p,[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 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args
      mb_env <- [Option] -> IO (Maybe [(String, String)])
    getGccEnv [Option]
    args2
      runSomethingWith logger "gcc" p args2 $ \[String]
    real_args ->
        CreateProcess -> IO (ExitCode, String)
    readCreateProcessWithExitCode' (String -> [String] -> CreateProcess
    proc String
    p [String]
    real_args){ env = mb_env }

    runAs :: Logger -> DynFlags -> [Option] -> IO ()
    runAs :: Logger -> DynFlags -> [Option] -> IO ()
    runAs Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "as" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    p,[Option]
    args0) = DynFlags -> (String, [Option])
    pgm_a 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_a)
          args2 :: [Option]
    args2 = [Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args
      mb_env <- [Option] -> IO (Maybe [(String, String)])
    getGccEnv [Option]
    args2
      runSomethingFiltered logger id "Assembler" p args2 Nothing mb_env

    -- | Run the LLVM Optimiser
    runLlvmOpt :: Logger -> DynFlags -> [Option] -> IO ()
    runLlvmOpt :: Logger -> DynFlags -> [Option] -> IO ()
    runLlvmOpt Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "opt" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    p,[Option]
    args0) = DynFlags -> (String, [Option])
    pgm_lo 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_lo)
          -- We take care to pass -optlo flags (e.g. args0) last to ensure that the
          -- user can override flags passed by GHC. See #14821.
      Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "LLVM Optimiser" String
    p ([Option]
    args1 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args0)

    -- | Run the LLVM Compiler
    runLlvmLlc :: Logger -> DynFlags -> [Option] -> IO ()
    runLlvmLlc :: Logger -> DynFlags -> [Option] -> IO ()
    runLlvmLlc Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "llc" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    p,[Option]
    args0) = DynFlags -> (String, [Option])
    pgm_lc 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_lc)
      Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "LLVM Compiler" String
    p ([Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args)

    -- | Run the LLVM Assembler
    runLlvmAs :: Logger -> DynFlags -> [Option] -> IO ()
    runLlvmAs :: Logger -> DynFlags -> [Option] -> IO ()
    runLlvmAs Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "llvm-as" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    p,[Option]
    args0) = DynFlags -> (String, [Option])
    pgm_las 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_las)
      Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "LLVM assembler" String
    p ([Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args1 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args)

    runEmscripten :: Logger -> DynFlags -> [Option] -> IO ()
    runEmscripten :: Logger -> DynFlags -> [Option] -> IO ()
    runEmscripten Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "emcc" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    p,[Option]
    args0) = DynFlags -> (String, [Option])
    pgm_a DynFlags
    dflags
          args1 :: [Option]
    args1     = [Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args
      Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "Emscripten" String
    p [Option]
    args1

    -- | Figure out which version of LLVM we are running this session
    figureLlvmVersion :: Logger -> DynFlags -> IO (Maybe LlvmVersion)
    figureLlvmVersion :: Logger -> DynFlags -> IO (Maybe LlvmVersion)
    figureLlvmVersion Logger
    logger DynFlags
    dflags = Logger
    -> String -> IO (Maybe LlvmVersion) -> IO (Maybe LlvmVersion)
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "llc" (IO (Maybe LlvmVersion) -> IO (Maybe LlvmVersion))
    -> IO (Maybe LlvmVersion) -> IO (Maybe LlvmVersion)
    forall a b. (a -> b) -> a -> b
    $ do
      let (String
    pgm,[Option]
    opts) = DynFlags -> (String, [Option])
    pgm_lc DynFlags
    dflags
          args :: [String]
    args = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull ((Option -> String) -> [Option] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Option -> String
    showOpt [Option]
    opts)
          -- we grab the args even though they should be useless just in
          -- case the user is using a customised 'llc' that requires some
          -- of the options they've specified. llc doesn't care what other
          -- options are specified when '-version' is used.
          args' :: [String]
    args' = [String]
    args [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "-version"]
      IO (Maybe LlvmVersion)
    -> (IOException -> IO (Maybe LlvmVersion))
    -> IO (Maybe LlvmVersion)
    forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO (do
                  (pin, pout, perr, p) <- String
    -> [String]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO (Handle, Handle, Handle, ProcessHandle)
    runInteractiveProcess String
    pgm [String]
    args'
                                                  Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing
                  {- > llc -version
                      <vendor> LLVM version 15.0.7
                        ...
                      OR
                      LLVM (http://llvm.org/):
                        LLVM version 14.0.6
                  -}
                  hSetBinaryMode pout False
                  line1 <- hGetLine pout
                  mb_ver <- case parseLlvmVersion line1 of
                    mb_ver :: Maybe LlvmVersion
    mb_ver@(Just LlvmVersion
    _) -> Maybe LlvmVersion -> IO (Maybe LlvmVersion)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LlvmVersion
    mb_ver
                    Maybe LlvmVersion
    Nothing -> String -> Maybe LlvmVersion
    parseLlvmVersion (String -> Maybe LlvmVersion)
    -> IO String -> IO (Maybe LlvmVersion)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> IO String
    hGetLine Handle
    pout -- Try the second line
                  hClose pin
                  hClose pout
                  hClose perr
                  _ <- waitForProcess p
                  return mb_ver
                )
                (\IOException
    err -> do
                    Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2
                        (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Error (figuring out LLVM version):" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+>
                          String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (IOException -> String
    forall a. Show a => a -> String
    show IOException
    err))
                    Logger -> SDoc -> IO ()
    errorMsg Logger
    logger (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat
                        [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Warning:", Int -> SDoc -> SDoc
    nest Int
    9 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Couldn't figure out LLVM version!" SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                              String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (String
    "Make sure you have installed LLVM between ["
                                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ LlvmVersion -> String
    llvmVersionStr LlvmVersion
    supportedLlvmVersionLowerBound
                                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " and "
                                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ LlvmVersion -> String
    llvmVersionStr LlvmVersion
    supportedLlvmVersionUpperBound
                                    String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")") ]
                    Maybe LlvmVersion -> IO (Maybe LlvmVersion)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe LlvmVersion
    forall a. Maybe a
    Nothing)

    -- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
    runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
    runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
    runMergeObjects Logger
    logger TmpFs
    tmpfs DynFlags
    dflags [Option]
    args =
      Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "merge-objects" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
        let (String
    p,[Option]
    args0) = (String, [Option])
    -> Maybe (String, [Option]) -> (String, [Option])
    forall a. a -> Maybe a -> a
    fromMaybe (String, [Option])
    forall {a}. a
    err (DynFlags -> Maybe (String, [Option])
    pgm_lm DynFlags
    dflags)
            err :: a
    err = GhcException -> a
    forall a. GhcException -> a
    throwGhcException (GhcException -> a) -> GhcException -> a
    forall a b. (a -> b) -> a -> b
    $ String -> GhcException
    UsageError (String -> GhcException) -> String -> GhcException
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords
                [ String
    "Attempted to merge object files but the configured linker"
                , String
    "does not support object merging." ]
            optl_args :: [Option]
    optl_args = (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_lm)
            args2 :: [Option]
    args2     = [Option]
    args0 [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    args [Option] -> [Option] -> [Option]
    forall a. [a] -> [a] -> [a]
    ++ [Option]
    optl_args
        if ToolSettings -> Bool
    toolSettings_mergeObjsSupportsResponseFiles (DynFlags -> ToolSettings
    toolSettings DynFlags
    dflags)
          then do
            mb_env <- [Option] -> IO (Maybe [(String, String)])
    getGccEnv [Option]
    args2
            runSomethingResponseFile logger tmpfs (tmpDir dflags) id "Merge objects" p args2 mb_env
          else do
            Logger -> String -> String -> [Option] -> IO ()
    runSomething Logger
    logger String
    "Merge objects" String
    p [Option]
    args2

    runAr :: Logger -> DynFlags -> Maybe FilePath -> [Option] -> IO ()
    runAr :: Logger -> DynFlags -> Maybe String -> [Option] -> IO ()
    runAr Logger
    logger DynFlags
    dflags Maybe String
    cwd [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "ar" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let ar :: String
    ar = DynFlags -> String
    pgm_ar DynFlags
    dflags
      Logger
    -> (String -> String)
    -> String
    -> String
    -> [Option]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    runSomethingFiltered Logger
    logger String -> String
    forall a. a -> a
    id String
    "Ar" String
    ar [Option]
    args Maybe String
    cwd Maybe [(String, String)]
    forall a. Maybe a
    Nothing

    askOtool :: Logger -> ToolSettings -> Maybe FilePath -> [Option] -> IO String
    askOtool :: Logger -> ToolSettings -> Maybe String -> [Option] -> IO String
    askOtool Logger
    logger ToolSettings
    toolSettings Maybe String
    mb_cwd [Option]
    args = do
      let otool :: String
    otool = ToolSettings -> String
    toolSettings_pgm_otool ToolSettings
    toolSettings
      Logger
    -> String
    -> String
    -> [Option]
    -> ([String] -> IO (ExitCode, String))
    -> IO String
    forall a.
    Logger
    -> String
    -> String
    -> [Option]
    -> ([String] -> IO (ExitCode, a))
    -> IO a
    runSomethingWith Logger
    logger String
    "otool" String
    otool [Option]
    args (([String] -> IO (ExitCode, String)) -> IO String)
    -> ([String] -> IO (ExitCode, String)) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \[String]
    real_args ->
        CreateProcess -> IO (ExitCode, String)
    readCreateProcessWithExitCode' (String -> [String] -> CreateProcess
    proc String
    otool [String]
    real_args){ cwd = mb_cwd }

    runInstallNameTool :: Logger -> ToolSettings -> [Option] -> IO ()
    runInstallNameTool :: Logger -> ToolSettings -> [Option] -> IO ()
    runInstallNameTool Logger
    logger ToolSettings
    toolSettings [Option]
    args = do
      let tool :: String
    tool = ToolSettings -> String
    toolSettings_pgm_install_name_tool ToolSettings
    toolSettings
      Logger
    -> (String -> String)
    -> String
    -> String
    -> [Option]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    runSomethingFiltered Logger
    logger String -> String
    forall a. a -> a
    id String
    "Install Name Tool" String
    tool [Option]
    args Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing

    runRanlib :: Logger -> DynFlags -> [Option] -> IO ()
    runRanlib :: Logger -> DynFlags -> [Option] -> IO ()
    runRanlib Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "ranlib" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let ranlib :: String
    ranlib = DynFlags -> String
    pgm_ranlib DynFlags
    dflags
      Logger
    -> (String -> String)
    -> String
    -> String
    -> [Option]
    -> Maybe String
    -> Maybe [(String, String)]
    -> IO ()
    runSomethingFiltered Logger
    logger String -> String
    forall a. a -> a
    id String
    "Ranlib" String
    ranlib [Option]
    args Maybe String
    forall a. Maybe a
    Nothing Maybe [(String, String)]
    forall a. Maybe a
    Nothing

    runWindres :: Logger -> DynFlags -> [Option] -> IO ()
    runWindres :: Logger -> DynFlags -> [Option] -> IO ()
    runWindres Logger
    logger DynFlags
    dflags [Option]
    args = Logger -> String -> IO () -> IO ()
    forall a. Logger -> String -> IO a -> IO a
    traceSystoolCommand Logger
    logger String
    "windres" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      let cc_args :: [Option]
    cc_args = (String -> Option) -> [String] -> [Option]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Option
    Option (Settings -> [String]
    sOpt_c (DynFlags -> Settings
    settings DynFlags
    dflags))
          windres :: String
    windres = DynFlags -> String
    pgm_windres DynFlags
    dflags
          opts :: [Option]
    opts = (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_windres)
      mb_env <- [Option] -> IO (Maybe [(String, String)])
    getGccEnv [Option]
    cc_args
      runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env