{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
--
-- Tasks running external programs for SysTools
--
-- (c) The GHC Team 2017
--
-----------------------------------------------------------------------------
module GHC.SysTools.Tasks where

import GHC.Utils.Exception as Exception
import GHC.Utils.Error
import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersionLowerBound, supportedLlvmVersionUpperBound, llvmVersionStr, parseLlvmVersion)
import GHC.Driver.Types
import GHC.Driver.Session
import GHC.Utils.Outputable
import GHC.Platform
import GHC.Utils.Misc

import Data.List
import Data.Char
import Data.Maybe

import System.IO
import System.Process
import GHC.Prelude

import GHC.SysTools.Process
import GHC.SysTools.Info

import Control.Monad (join, forM, filterM, void)
import System.Directory (doesFileExist)
import System.FilePath ((</>))
import Text.ParserCombinators.ReadP as Parser

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

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

runCpp :: DynFlags -> [Option] -> IO ()
runCpp :: DynFlags -> [Option] -> IO ()
runCpp DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"cpp" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let (FilePath
p,[Option]
args0) = DynFlags -> (FilePath, [Option])
pgm_P DynFlags
dflags
      args1 :: [Option]
args1 = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_P)
      args2 :: [Option]
args2 = [FilePath -> Option
Option FilePath
"-Werror" | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WarnIsError DynFlags
dflags]
                [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [FilePath -> Option
Option FilePath
"-Wundef" | WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnCPPUndef DynFlags
dflags]
  Maybe [(FilePath, FilePath)]
mb_env <- [Option] -> IO (Maybe [(FilePath, FilePath)])
getGccEnv [Option]
args2
  DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingFiltered DynFlags
dflags FilePath -> FilePath
forall a. a -> a
id  FilePath
"C pre-processor" FilePath
p
                       ([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) Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
mb_env

runPp :: DynFlags -> [Option] -> IO ()
runPp :: DynFlags -> [Option] -> IO ()
runPp DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"pp" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let prog :: FilePath
prog = DynFlags -> FilePath
pgm_F DynFlags
dflags
      opts :: [Option]
opts = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_F)
  DynFlags -> FilePath -> FilePath -> [Option] -> IO ()
runSomething DynFlags
dflags FilePath
"Haskell pre-processor" FilePath
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 -> DynFlags -> [Option] -> IO ()
runCc :: Maybe ForeignSrcLang -> DynFlags -> [Option] -> IO ()
runCc Maybe ForeignSrcLang
mLanguage DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"cc" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let p :: FilePath
p = DynFlags -> FilePath
pgm_c DynFlags
dflags
      args1 :: [Option]
args1 = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option [FilePath]
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.
  Maybe [(FilePath, FilePath)]
mb_env <- [Option] -> IO (Maybe [(FilePath, FilePath)])
getGccEnv [Option]
args2
  DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingResponseFile DynFlags
dflags FilePath -> FilePath
cc_filter FilePath
"C Compiler" FilePath
p [Option]
args2 Maybe [(FilePath, FilePath)]
mb_env
 where
  -- discard some harmless warnings from gcc that we can't turn off
  cc_filter :: FilePath -> FilePath
cc_filter = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
doFilter ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines

  {-
  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 :: [FilePath] -> [FilePath]
doFilter = [([FilePath], [FilePath])] -> [FilePath]
unChunkWarnings ([([FilePath], [FilePath])] -> [FilePath])
-> ([FilePath] -> [([FilePath], [FilePath])])
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([FilePath], [FilePath])] -> [([FilePath], [FilePath])]
filterWarnings ([([FilePath], [FilePath])] -> [([FilePath], [FilePath])])
-> ([FilePath] -> [([FilePath], [FilePath])])
-> [FilePath]
-> [([FilePath], [FilePath])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [([FilePath], [FilePath])]
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 :: [FilePath] -> [FilePath] -> [([FilePath], [FilePath])]
chunkWarnings [FilePath]
loc_stack [] = [([FilePath]
loc_stack, [])]
  chunkWarnings [FilePath]
loc_stack [FilePath]
xs
      = case (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break FilePath -> Bool
loc_stack_start [FilePath]
xs of
        ([FilePath]
warnings, FilePath
lss:[FilePath]
xs') ->
            case (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span FilePath -> Bool
loc_start_continuation [FilePath]
xs' of
            ([FilePath]
lsc, [FilePath]
xs'') ->
                ([FilePath]
loc_stack, [FilePath]
warnings) ([FilePath], [FilePath])
-> [([FilePath], [FilePath])] -> [([FilePath], [FilePath])]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath] -> [([FilePath], [FilePath])]
chunkWarnings (FilePath
lss FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
lsc) [FilePath]
xs''
        ([FilePath], [FilePath])
_ -> [([FilePath]
loc_stack, [FilePath]
xs)]

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

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

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

  -- 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, [FilePath]
userOpts) = case Maybe ForeignSrcLang
mLanguage of
    Maybe ForeignSrcLang
Nothing -> ([], [FilePath]
userOpts_c)
    Just ForeignSrcLang
language -> ([FilePath -> Option
Option FilePath
"-x", FilePath -> Option
Option FilePath
languageName], [FilePath]
opts)
      where
        (FilePath
languageName, [FilePath]
opts) = case ForeignSrcLang
language of
          ForeignSrcLang
LangC      -> (FilePath
"c",             [FilePath]
userOpts_c)
          ForeignSrcLang
LangCxx    -> (FilePath
"c++",           [FilePath]
userOpts_cxx)
          ForeignSrcLang
LangObjc   -> (FilePath
"objective-c",   [FilePath]
userOpts_c)
          ForeignSrcLang
LangObjcxx -> (FilePath
"objective-c++", [FilePath]
userOpts_cxx)
          ForeignSrcLang
LangAsm    -> (FilePath
"assembler",     [])
          ForeignSrcLang
RawObject  -> (FilePath
"c",             []) -- claim C for lack of a better idea
  userOpts_c :: [FilePath]
userOpts_c   = DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_c
  userOpts_cxx :: [FilePath]
userOpts_cxx = DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_cxx

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

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

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

-- | Run the LLVM Optimiser
runLlvmOpt :: DynFlags -> [Option] -> IO ()
runLlvmOpt :: DynFlags -> [Option] -> IO ()
runLlvmOpt DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"opt" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let (FilePath
p,[Option]
args0) = DynFlags -> (FilePath, [Option])
pgm_lo DynFlags
dflags
      args1 :: [Option]
args1 = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
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.
  DynFlags -> FilePath -> FilePath -> [Option] -> IO ()
runSomething DynFlags
dflags FilePath
"LLVM Optimiser" FilePath
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 :: DynFlags -> [Option] -> IO ()
runLlvmLlc :: DynFlags -> [Option] -> IO ()
runLlvmLlc DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"llc" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let (FilePath
p,[Option]
args0) = DynFlags -> (FilePath, [Option])
pgm_lc DynFlags
dflags
      args1 :: [Option]
args1 = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_lc)
  DynFlags -> FilePath -> FilePath -> [Option] -> IO ()
runSomething DynFlags
dflags FilePath
"LLVM Compiler" FilePath
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 clang compiler (used as an assembler for the LLVM
-- backend on OS X as LLVM doesn't support the OS X system
-- assembler)
runClang :: DynFlags -> [Option] -> IO ()
runClang :: DynFlags -> [Option] -> IO ()
runClang DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"clang" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let (FilePath
clang,[Option]
_) = DynFlags -> (FilePath, [Option])
pgm_lcc DynFlags
dflags
      -- be careful what options we call clang with
      -- see #5903 and #7617 for bugs caused by this.
      (FilePath
_,[Option]
args0) = DynFlags -> (FilePath, [Option])
pgm_a DynFlags
dflags
      args1 :: [Option]
args1 = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
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
  Maybe [(FilePath, FilePath)]
mb_env <- [Option] -> IO (Maybe [(FilePath, FilePath)])
getGccEnv [Option]
args2
  IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (do
        DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingFiltered DynFlags
dflags FilePath -> FilePath
forall a. a -> a
id FilePath
"Clang (Assembler)" FilePath
clang [Option]
args2 Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
mb_env
    )
    (\(SomeException
err :: SomeException) -> do
        DynFlags -> MsgDoc -> IO ()
errorMsg DynFlags
dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> MsgDoc
text (FilePath
"Error running clang! you need clang installed to use the" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                  FilePath
" LLVM backend") MsgDoc -> MsgDoc -> MsgDoc
$+$
            FilePath -> MsgDoc
text FilePath
"(or GHC tried to execute clang incorrectly)"
        SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
err
    )

-- | Figure out which version of LLVM we are running this session
figureLlvmVersion :: DynFlags -> IO (Maybe LlvmVersion)
figureLlvmVersion :: DynFlags -> IO (Maybe LlvmVersion)
figureLlvmVersion DynFlags
dflags = DynFlags
-> FilePath -> IO (Maybe LlvmVersion) -> IO (Maybe LlvmVersion)
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"llc" (IO (Maybe LlvmVersion) -> IO (Maybe LlvmVersion))
-> IO (Maybe LlvmVersion) -> IO (Maybe LlvmVersion)
forall a b. (a -> b) -> a -> b
$ do
  let (FilePath
pgm,[Option]
opts) = DynFlags -> (FilePath, [Option])
pgm_lc DynFlags
dflags
      args :: [FilePath]
args = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
forall a. [a] -> Bool
notNull ((Option -> FilePath) -> [Option] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Option -> FilePath
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' :: [FilePath]
args' = [FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-version"]
  IO (Maybe LlvmVersion)
-> (IOException -> IO (Maybe LlvmVersion))
-> IO (Maybe LlvmVersion)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (do
              (Handle
pin, Handle
pout, Handle
perr, ProcessHandle
p) <- FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess FilePath
pgm [FilePath]
args'
                                              Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
              {- > llc -version
                  LLVM (http://llvm.org/):
                    LLVM version 3.5.2
                    ...
              -}
              Handle -> Bool -> IO ()
hSetBinaryMode Handle
pout Bool
False
              FilePath
_     <- Handle -> IO FilePath
hGetLine Handle
pout
              FilePath
vline <- Handle -> IO FilePath
hGetLine Handle
pout
              let mb_ver :: Maybe LlvmVersion
mb_ver = FilePath -> Maybe LlvmVersion
parseLlvmVersion FilePath
vline
              Handle -> IO ()
hClose Handle
pin
              Handle -> IO ()
hClose Handle
pout
              Handle -> IO ()
hClose Handle
perr
              ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
              Maybe LlvmVersion -> IO (Maybe LlvmVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LlvmVersion
mb_ver
            )
            (\IOException
err -> do
                DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2
                    (FilePath -> MsgDoc
text FilePath
"Error (figuring out LLVM version):" MsgDoc -> MsgDoc -> MsgDoc
<+>
                      FilePath -> MsgDoc
text (IOException -> FilePath
forall a. Show a => a -> FilePath
show IOException
err))
                DynFlags -> MsgDoc -> IO ()
errorMsg DynFlags
dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [MsgDoc] -> MsgDoc
vcat
                    [ FilePath -> MsgDoc
text FilePath
"Warning:", Int -> MsgDoc -> MsgDoc
nest Int
9 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
                          FilePath -> MsgDoc
text FilePath
"Couldn't figure out LLVM version!" MsgDoc -> MsgDoc -> MsgDoc
$$
                          FilePath -> MsgDoc
text (FilePath
"Make sure you have installed LLVM between ["
                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ LlvmVersion -> FilePath
llvmVersionStr LlvmVersion
supportedLlvmVersionLowerBound
                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" and "
                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ LlvmVersion -> FilePath
llvmVersionStr LlvmVersion
supportedLlvmVersionUpperBound
                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
")") ]
                Maybe LlvmVersion -> IO (Maybe LlvmVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LlvmVersion
forall a. Maybe a
Nothing)


-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused
-- libraries from the dynamic library.  We do this to reduce the number of load
-- commands that end up in the dylib, and has been limited to 32K (32768) since
-- macOS Sierra (10.14).
--
-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing
-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not
-- being included in the load commands, however the @-rpath@ entries are all
-- forced to be included.  This can lead to 100s of @-rpath@ entries being
-- included when only a handful of libraries end up being truely linked.
--
-- Thus after building the library, we run a fixup phase where we inject the
-- @-rpath@ for each found library (in the given library search paths) into the
-- dynamic library through @-add_rpath@.
--
-- See Note [Dynamic linking on macOS]
runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO ()
runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO ()
runInjectRPaths DynFlags
dflags [FilePath]
_ FilePath
_ | Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RPath DynFlags
dflags) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runInjectRPaths DynFlags
dflags [FilePath]
lib_paths FilePath
dylib = do
  [FilePath]
info <- FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> Maybe FilePath -> [Option] -> IO FilePath
askOtool DynFlags
dflags Maybe FilePath
forall a. Maybe a
Nothing [FilePath -> Option
Option FilePath
"-L", FilePath -> Option
Option FilePath
dylib]
  -- filter the output for only the libraries. And then drop the @rpath prefix.
  let libs :: [FilePath]
libs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
7) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
"@rpath") ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> FilePath
forall a. [a] -> a
head([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FilePath -> [FilePath]
words) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
info
  -- find any pre-existing LC_PATH items
  [FilePath]
info <- FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynFlags -> Maybe FilePath -> [Option] -> IO FilePath
askOtool DynFlags
dflags Maybe FilePath
forall a. Maybe a
Nothing [FilePath -> Option
Option FilePath
"-l", FilePath -> Option
Option FilePath
dylib]

  let paths :: [FilePath]
paths = (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe FilePath
get_rpath [FilePath]
info
      lib_paths' :: [FilePath]
lib_paths' = [ FilePath
p | FilePath
p <- [FilePath]
lib_paths, Bool -> Bool
not (FilePath
p FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
paths) ]
  -- only find those rpaths, that aren't already in the library.
  [FilePath]
rpaths <- [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[[FilePath]] -> [FilePath]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
libs (\FilePath
f -> (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (\FilePath
l -> FilePath -> IO Bool
doesFileExist (FilePath
l FilePath -> FilePath -> FilePath
</> FilePath
f)) [FilePath]
lib_paths')
  -- inject the rpaths
  case [FilePath]
rpaths of
    [] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [FilePath]
_  -> DynFlags -> [Option] -> IO ()
runInstallNameTool DynFlags
dflags ([Option] -> IO ()) -> [Option] -> IO ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option ([FilePath] -> [Option]) -> [FilePath] -> [Option]
forall a b. (a -> b) -> a -> b
$ FilePath
"-add_rpath"FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:(FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
"-add_rpath" [FilePath]
rpaths) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
dylib]

get_rpath :: String -> Maybe FilePath
get_rpath :: FilePath -> Maybe FilePath
get_rpath FilePath
l = case ReadP FilePath -> ReadS FilePath
forall a. ReadP a -> ReadS a
readP_to_S ReadP FilePath
rpath_parser FilePath
l of
                [(FilePath
rpath, FilePath
"")] -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
rpath
                [(FilePath, FilePath)]
_ -> Maybe FilePath
forall a. Maybe a
Nothing


rpath_parser :: ReadP FilePath
rpath_parser :: ReadP FilePath
rpath_parser = do
  ReadP ()
skipSpaces
  ReadP FilePath -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ReadP FilePath
string FilePath
"path"
  ReadP FilePath -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
forall a b. (a -> b) -> a -> b
$ ReadP Char -> ReadP FilePath
forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isSpace)
  FilePath
rpath <- ReadP Char -> ReadP FilePath
forall a. ReadP a -> ReadP [a]
many ReadP Char
get
  ReadP FilePath -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
forall a b. (a -> b) -> a -> b
$ ReadP Char -> ReadP FilePath
forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isSpace)
  ReadP FilePath -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ReadP FilePath
string FilePath
"(offset "
  ReadP FilePath -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP FilePath -> ReadP ()) -> ReadP FilePath -> ReadP ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP FilePath
munch1 Char -> Bool
isDigit
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
Parser.char Char
')'
  ReadP ()
skipSpaces
  FilePath -> ReadP FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
rpath

runLink :: DynFlags -> [Option] -> IO ()
runLink :: DynFlags -> [Option] -> IO ()
runLink DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"linker" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  -- See Note [Run-time linker info]
  --
  -- `-optl` args come at the end, so that later `-l` options
  -- given there manually can fill in symbols needed by
  -- Haskell libraries coming in via `args`.
  [Option]
linkargs <- LinkerInfo -> [Option]
neededLinkArgs (LinkerInfo -> [Option]) -> IO LinkerInfo -> IO [Option]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DynFlags -> IO LinkerInfo
getLinkerInfo DynFlags
dflags
  let (FilePath
p,[Option]
args0) = DynFlags -> (FilePath, [Option])
pgm_l DynFlags
dflags
      optl_args :: [Option]
optl_args = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_l)
      args2 :: [Option]
args2     = [Option]
args0 [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
linkargs [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
optl_args
  Maybe [(FilePath, FilePath)]
mb_env <- [Option] -> IO (Maybe [(FilePath, FilePath)])
getGccEnv [Option]
args2
  DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingResponseFile DynFlags
dflags FilePath -> FilePath
ld_filter FilePath
"Linker" FilePath
p [Option]
args2 Maybe [(FilePath, FilePath)]
mb_env
  where
    ld_filter :: FilePath -> FilePath
ld_filter = case (Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags)) of
                  OS
OSSolaris2 -> FilePath -> FilePath
sunos_ld_filter
                  OS
_ -> FilePath -> FilePath
forall a. a -> a
id
{-
  SunOS/Solaris ld emits harmless warning messages about unresolved
  symbols in case of compiling into shared library when we do not
  link against all the required libs. That is the case of GHC which
  does not link against RTS library explicitly in order to be able to
  choose the library later based on binary application linking
  parameters. The warnings look like:

Undefined                       first referenced
  symbol                             in file
stg_ap_n_fast                       ./T2386_Lib.o
stg_upd_frame_info                  ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_litE_closure ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_appE_closure ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_conE_closure ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziSyntax_mkNameGzud_closure ./T2386_Lib.o
newCAF                              ./T2386_Lib.o
stg_bh_upd_frame_info               ./T2386_Lib.o
stg_ap_ppp_fast                     ./T2386_Lib.o
templatezmhaskell_LanguageziHaskellziTHziLib_stringL_closure ./T2386_Lib.o
stg_ap_p_fast                       ./T2386_Lib.o
stg_ap_pp_fast                      ./T2386_Lib.o
ld: warning: symbol referencing errors

  this is actually coming from T2386 testcase. The emitting of those
  warnings is also a reason why so many TH testcases fail on Solaris.

  Following filter code is SunOS/Solaris linker specific and should
  filter out only linker warnings. Please note that the logic is a
  little bit more complex due to the simple reason that we need to preserve
  any other linker emitted messages. If there are any. Simply speaking
  if we see "Undefined" and later "ld: warning:..." then we omit all
  text between (including) the marks. Otherwise we copy the whole output.
-}
    sunos_ld_filter :: String -> String
    sunos_ld_filter :: FilePath -> FilePath
sunos_ld_filter = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
sunos_ld_filter' ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
    sunos_ld_filter' :: [FilePath] -> [FilePath]
sunos_ld_filter' [FilePath]
x = if ([FilePath] -> Bool
undefined_found [FilePath]
x Bool -> Bool -> Bool
&& [FilePath] -> Bool
ld_warning_found [FilePath]
x)
                          then ([FilePath] -> [FilePath]
ld_prefix [FilePath]
x) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ([FilePath] -> [FilePath]
ld_postfix [FilePath]
x)
                          else [FilePath]
x
    breakStartsWith :: [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith [a]
x [[a]]
y = ([a] -> Bool) -> [[a]] -> ([[a]], [[a]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
x) [[a]]
y
    ld_prefix :: [FilePath] -> [FilePath]
ld_prefix = ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> ([FilePath], [FilePath])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith FilePath
"Undefined"
    undefined_found :: [FilePath] -> Bool
undefined_found = Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> ([FilePath], [FilePath])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith FilePath
"Undefined"
    ld_warn_break :: [FilePath] -> ([FilePath], [FilePath])
ld_warn_break = FilePath -> [FilePath] -> ([FilePath], [FilePath])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith FilePath
"ld: warning: symbol referencing errors"
    ld_postfix :: [FilePath] -> [FilePath]
ld_postfix = [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ([FilePath], [FilePath])
ld_warn_break
    ld_warning_found :: [FilePath] -> Bool
ld_warning_found = Bool -> Bool
not (Bool -> Bool) -> ([FilePath] -> Bool) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> ([FilePath], [FilePath])
ld_warn_break

-- See Note [Merging object files for GHCi] in GHC.Driver.Pipeline.
runMergeObjects :: DynFlags -> [Option] -> IO ()
runMergeObjects :: DynFlags -> [Option] -> IO ()
runMergeObjects DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"merge-objects" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let (FilePath
p,[Option]
args0) = DynFlags -> (FilePath, [Option])
pgm_lm DynFlags
dflags
      optl_args :: [Option]
optl_args = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
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
  -- N.B. Darwin's ld64 doesn't support response files. Consequently we only
  -- use them on Windows where they are truly necessary.
#if defined(mingw32_HOST_OS)
  mb_env <- getGccEnv args2
  runSomethingResponseFile dflags id "Merge objects" p args2 mb_env
#else
  DynFlags -> FilePath -> FilePath -> [Option] -> IO ()
runSomething DynFlags
dflags FilePath
"Merge objects" FilePath
p [Option]
args2
#endif

runLibtool :: DynFlags -> [Option] -> IO ()
runLibtool :: DynFlags -> [Option] -> IO ()
runLibtool DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"libtool" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  [Option]
linkargs <- LinkerInfo -> [Option]
neededLinkArgs (LinkerInfo -> [Option]) -> IO LinkerInfo -> IO [Option]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` DynFlags -> IO LinkerInfo
getLinkerInfo DynFlags
dflags
  let args1 :: [Option]
args1      = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_l)
      args2 :: [Option]
args2      = [FilePath -> Option
Option FilePath
"-static"] [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args1 [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
linkargs
      libtool :: FilePath
libtool    = DynFlags -> FilePath
pgm_libtool DynFlags
dflags
  Maybe [(FilePath, FilePath)]
mb_env <- [Option] -> IO (Maybe [(FilePath, FilePath)])
getGccEnv [Option]
args2
  DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingFiltered DynFlags
dflags FilePath -> FilePath
forall a. a -> a
id FilePath
"Libtool" FilePath
libtool [Option]
args2 Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
mb_env

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

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

runInstallNameTool :: DynFlags -> [Option] -> IO ()
runInstallNameTool :: DynFlags -> [Option] -> IO ()
runInstallNameTool DynFlags
dflags [Option]
args = do
  let tool :: FilePath
tool = DynFlags -> FilePath
pgm_install_name_tool DynFlags
dflags
  DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingFiltered DynFlags
dflags FilePath -> FilePath
forall a. a -> a
id FilePath
"Install Name Tool" FilePath
tool [Option]
args Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing

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

runWindres :: DynFlags -> [Option] -> IO ()
runWindres :: DynFlags -> [Option] -> IO ()
runWindres DynFlags
dflags [Option]
args = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"windres" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  let cc :: FilePath
cc = DynFlags -> FilePath
pgm_c DynFlags
dflags
      cc_args :: [Option]
cc_args = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (Settings -> [FilePath]
sOpt_c (DynFlags -> Settings
settings DynFlags
dflags))
      windres :: FilePath
windres = DynFlags -> FilePath
pgm_windres DynFlags
dflags
      opts :: [Option]
opts = (FilePath -> Option) -> [FilePath] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Option
Option (DynFlags -> (DynFlags -> [FilePath]) -> [FilePath]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [FilePath]
opt_windres)
      quote :: FilePath -> FilePath
quote FilePath
x = FilePath
"\"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\""
      args' :: [Option]
args' = -- If windres.exe and gcc.exe are in a directory containing
              -- spaces then windres fails to run gcc. We therefore need
              -- to tell it what command to use...
              FilePath -> Option
Option (FilePath
"--preprocessor=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                      [FilePath] -> FilePath
unwords ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
quote (FilePath
cc FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
                                          (Option -> FilePath) -> [Option] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Option -> FilePath
showOpt [Option]
opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
                                          [FilePath
"-E", FilePath
"-xc", FilePath
"-DRC_INVOKED"])))
              -- ...but if we do that then if windres calls popen then
              -- it can't understand the quoting, so we have to use
              -- --use-temp-file so that it interprets it correctly.
              -- See #1828.
            Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: FilePath -> Option
Option FilePath
"--use-temp-file"
            Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
args
  Maybe [(FilePath, FilePath)]
mb_env <- [Option] -> IO (Maybe [(FilePath, FilePath)])
getGccEnv [Option]
cc_args
  DynFlags
-> (FilePath -> FilePath)
-> FilePath
-> FilePath
-> [Option]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> IO ()
runSomethingFiltered DynFlags
dflags FilePath -> FilePath
forall a. a -> a
id FilePath
"Windres" FilePath
windres [Option]
args' Maybe FilePath
forall a. Maybe a
Nothing Maybe [(FilePath, FilePath)]
mb_env

touch :: DynFlags -> String -> String -> IO ()
touch :: DynFlags -> FilePath -> FilePath -> IO ()
touch DynFlags
dflags FilePath
purpose FilePath
arg = DynFlags -> FilePath -> IO () -> IO ()
forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
"touch" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
  DynFlags -> FilePath -> FilePath -> [Option] -> IO ()
runSomething DynFlags
dflags FilePath
purpose (DynFlags -> FilePath
pgm_T DynFlags
dflags) [FilePath -> FilePath -> Option
FileOption FilePath
"" FilePath
arg]

-- * Tracing utility

-- | Record in the eventlog when the given tool command starts
--   and finishes, prepending the given 'String' with
--   \"systool:\", to easily be able to collect and process
--   all the systool events.
--
--   For those events to show up in the eventlog, you need
--   to run GHC with @-v2@ or @-ddump-timings@.
traceToolCommand :: DynFlags -> String -> IO a -> IO a
traceToolCommand :: forall a. DynFlags -> FilePath -> IO a -> IO a
traceToolCommand DynFlags
dflags FilePath
tool = DynFlags -> MsgDoc -> (a -> ()) -> IO a -> IO a
forall (m :: * -> *) a.
MonadIO m =>
DynFlags -> MsgDoc -> (a -> ()) -> m a -> m a
withTiming
  DynFlags
dflags (FilePath -> MsgDoc
text (FilePath -> MsgDoc) -> FilePath -> MsgDoc
forall a b. (a -> b) -> a -> b
$ FilePath
"systool:" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tool) (() -> a -> ()
forall a b. a -> b -> a
const ())