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

import Exception
import ErrUtils
import DynFlags
import Outputable
import Platform
import Util

import Data.List

import System.IO
import System.Process
import GhcPrelude

import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion)

import SysTools.Process
import SysTools.Info

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

runUnlit :: DynFlags -> [Option] -> IO ()
runUnlit :: DynFlags -> [Option] -> IO ()
runUnlit dflags :: DynFlags
dflags args :: [Option]
args = 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
  DynFlags -> String -> String -> [Option] -> IO ()
runSomething DynFlags
dflags "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)

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

runPp :: DynFlags -> [Option] -> IO ()
runPp :: DynFlags -> [Option] -> IO ()
runPp dflags :: DynFlags
dflags args :: [Option]
args =   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)
  DynFlags -> String -> String -> [Option] -> IO ()
runSomething DynFlags
dflags "Haskell pre-processor" String
prog ([Option]
args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
opts)

runCc :: DynFlags -> [Option] -> IO ()
runCc :: DynFlags -> [Option] -> IO ()
runCc dflags :: DynFlags
dflags args :: [Option]
args =   do
  let (p :: String
p,args0 :: [Option]
args0) = DynFlags -> (String, [Option])
pgm_c 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_c)
      args2 :: [Option]
args2 = [Option]
args0 [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 [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
  DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe [(String, String)]
-> IO ()
runSomethingResponseFile DynFlags
dflags String -> String
cc_filter "C Compiler" String
p [Option]
args2 Maybe [(String, String)]
mb_env
 where
  -- discard some harmless warnings from gcc that we can't turn off
  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

  {-
  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 loc_stack :: [String]
loc_stack [] = [([String]
loc_stack, [])]
  chunkWarnings loc_stack :: [String]
loc_stack xs :: [String]
xs
      = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
loc_stack_start [String]
xs of
        (warnings :: [String]
warnings, lss :: String
lss:xs' :: [String]
xs') ->
            case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span String -> Bool
loc_start_continuation [String]
xs' of
            (lsc :: [String]
lsc, xs'' :: [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]
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 ((xs :: [String]
xs, []) : zs :: [([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 ((xs :: [String]
xs, ys :: [String]
ys) : zs :: [([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
                                       ys' :: [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 ((xs :: [String]
xs, ys :: [String]
ys) : zs :: [([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        s :: String
s = "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 s :: String
s = "                 from " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s
  wantedWarning :: String -> Bool
wantedWarning w :: String
w
   | "warning: call-clobbered register used" String -> String -> Bool
`isContainedIn` String
w = Bool
False
   | Bool
otherwise = Bool
True

isContainedIn :: String -> String -> Bool
xs :: String
xs isContainedIn :: String -> String -> Bool
`isContainedIn` ys :: 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 :: DynFlags -> [Option] -> IO String
askLd :: DynFlags -> [Option] -> IO String
askLd dflags :: DynFlags
dflags args :: [Option]
args = do
  let (p :: String
p,args0 :: [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
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
  DynFlags
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, String))
-> IO String
forall a.
DynFlags
-> String
-> String
-> [Option]
-> ([String] -> IO (ExitCode, a))
-> IO a
runSomethingWith DynFlags
dflags "gcc" String
p [Option]
args2 (([String] -> IO (ExitCode, String)) -> IO String)
-> ([String] -> IO (ExitCode, String)) -> IO String
forall a b. (a -> b) -> a -> b
$ \real_args :: [String]
real_args ->
    CreateProcess -> IO (ExitCode, String)
readCreateProcessWithExitCode' (String -> [String] -> CreateProcess
proc String
p [String]
real_args){ env :: Maybe [(String, String)]
env = Maybe [(String, String)]
mb_env }

runSplit :: DynFlags -> [Option] -> IO ()
runSplit :: DynFlags -> [Option] -> IO ()
runSplit dflags :: DynFlags
dflags args :: [Option]
args = do
  let (p :: String
p,args0 :: [Option]
args0) = DynFlags -> (String, [Option])
pgm_s DynFlags
dflags
  DynFlags -> String -> String -> [Option] -> IO ()
runSomething DynFlags
dflags "Splitter" String
p ([Option]
args0[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++[Option]
args)

runAs :: DynFlags -> [Option] -> IO ()
runAs :: DynFlags -> [Option] -> IO ()
runAs dflags :: DynFlags
dflags args :: [Option]
args = do
  let (p :: String
p,args0 :: [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
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
  DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered DynFlags
dflags String -> String
forall a. a -> a
id "Assembler" String
p [Option]
args2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env

-- | Run the LLVM Optimiser
runLlvmOpt :: DynFlags -> [Option] -> IO ()
runLlvmOpt :: DynFlags -> [Option] -> IO ()
runLlvmOpt dflags :: DynFlags
dflags args :: [Option]
args = do
  let (p :: String
p,args0 :: [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.
  DynFlags -> String -> String -> [Option] -> IO ()
runSomething DynFlags
dflags "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 :: DynFlags -> [Option] -> IO ()
runLlvmLlc :: DynFlags -> [Option] -> IO ()
runLlvmLlc dflags :: DynFlags
dflags args :: [Option]
args = do
  let (p :: String
p,args0 :: [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)
  DynFlags -> String -> String -> [Option] -> IO ()
runSomething DynFlags
dflags "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 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 dflags :: DynFlags
dflags args :: [Option]
args = do
  let (clang :: String
clang,_) = DynFlags -> (String, [Option])
pgm_lcc DynFlags
dflags
      -- be careful what options we call clang with
      -- see #5903 and #7617 for bugs caused by this.
      (_,args0 :: [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
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
  IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch (do
        DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered DynFlags
dflags String -> String
forall a. a -> a
id "Clang (Assembler)" String
clang [Option]
args2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env
    )
    (\(SomeException
err :: SomeException) -> do
        DynFlags -> MsgDoc -> IO ()
errorMsg DynFlags
dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> MsgDoc
text ("Error running clang! you need clang installed to use the" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  " LLVM backend") MsgDoc -> MsgDoc -> MsgDoc
$+$
            String -> MsgDoc
text "(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 dflags :: DynFlags
dflags = do
  let (pgm :: String
pgm,opts :: [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 a. [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]
++ ["-version"]
  IO (Maybe LlvmVersion)
-> (IOException -> IO (Maybe LlvmVersion))
-> IO (Maybe LlvmVersion)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (do
              (pin :: Handle
pin, pout :: Handle
pout, perr :: Handle
perr, _) <- 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
                  LLVM (http://llvm.org/):
                    LLVM version 3.5.2
                    ...
              -}
              Handle -> Bool -> IO ()
hSetBinaryMode Handle
pout Bool
False
              String
_     <- Handle -> IO String
hGetLine Handle
pout
              String
vline <- Handle -> IO String
hGetLine Handle
pout
              let mb_ver :: Maybe LlvmVersion
mb_ver = String -> Maybe LlvmVersion
parseLlvmVersion String
vline
              Handle -> IO ()
hClose Handle
pin
              Handle -> IO ()
hClose Handle
pout
              Handle -> IO ()
hClose Handle
perr
              Maybe LlvmVersion -> IO (Maybe LlvmVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LlvmVersion
mb_ver
            )
            (\err :: IOException
err -> do
                DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags 2
                    (String -> MsgDoc
text "Error (figuring out LLVM version):" MsgDoc -> MsgDoc -> MsgDoc
<+>
                      String -> MsgDoc
text (IOException -> String
forall a. Show a => a -> String
show IOException
err))
                DynFlags -> MsgDoc -> IO ()
errorMsg DynFlags
dflags (MsgDoc -> IO ()) -> MsgDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ [MsgDoc] -> MsgDoc
vcat
                    [ String -> MsgDoc
text "Warning:", Int -> MsgDoc -> MsgDoc
nest 9 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$
                          String -> MsgDoc
text "Couldn't figure out LLVM version!" MsgDoc -> MsgDoc -> MsgDoc
$$
                          String -> MsgDoc
text ("Make sure you have installed LLVM " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                LlvmVersion -> String
llvmVersionStr LlvmVersion
supportedLlvmVersion) ]
                Maybe LlvmVersion -> IO (Maybe LlvmVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LlvmVersion
forall a. Maybe a
Nothing)


runLink :: DynFlags -> [Option] -> IO ()
runLink :: DynFlags -> [Option] -> IO ()
runLink dflags :: DynFlags
dflags args :: [Option]
args = do
  -- See Note [Run-time linker info]
  [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 (p :: String
p,args0 :: [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]
linkargs [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args1 [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
  DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe [(String, String)]
-> IO ()
runSomethingResponseFile DynFlags
dflags String -> String
ld_filter "Linker" String
p [Option]
args2 Maybe [(String, String)]
mb_env
  where
    ld_filter :: String -> String
ld_filter = case (Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags)) of
                  OSSolaris2 -> String -> String
sunos_ld_filter
                  _ -> String -> String
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 :: String -> String
sunos_ld_filter = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
sunos_ld_filter' ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    sunos_ld_filter' :: [String] -> [String]
sunos_ld_filter' x :: [String]
x = if ([String] -> Bool
undefined_found [String]
x Bool -> Bool -> Bool
&& [String] -> Bool
ld_warning_found [String]
x)
                          then ([String] -> [String]
ld_prefix [String]
x) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ([String] -> [String]
ld_postfix [String]
x)
                          else [String]
x
    breakStartsWith :: [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith x :: [a]
x y :: [[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 :: [String] -> [String]
ld_prefix = ([String], [String]) -> [String]
forall a b. (a, b) -> a
fst (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> ([String], [String])
forall a. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith "Undefined"
    undefined_found :: [String] -> Bool
undefined_found = Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> ([String], [String])
forall a. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith "Undefined"
    ld_warn_break :: [String] -> ([String], [String])
ld_warn_break = String -> [String] -> ([String], [String])
forall a. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith "ld: warning: symbol referencing errors"
    ld_postfix :: [String] -> [String]
ld_postfix = [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String], [String])
ld_warn_break
    ld_warning_found :: [String] -> Bool
ld_warning_found = Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> ([String] -> [String]) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String] -> ([String], [String])) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ([String], [String])
ld_warn_break


runLibtool :: DynFlags -> [Option] -> IO ()
runLibtool :: DynFlags -> [Option] -> IO ()
runLibtool dflags :: DynFlags
dflags args :: [Option]
args = 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      = (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      = [String -> Option
Option "-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 :: String
libtool    = DynFlags -> String
pgm_libtool DynFlags
dflags
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
  DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered DynFlags
dflags String -> String
forall a. a -> a
id "Linker" String
libtool [Option]
args2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env

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

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

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

runMkDLL :: DynFlags -> [Option] -> IO ()
runMkDLL :: DynFlags -> [Option] -> IO ()
runMkDLL dflags :: DynFlags
dflags args :: [Option]
args = do
  let (p :: String
p,args0 :: [Option]
args0) = DynFlags -> (String, [Option])
pgm_dll DynFlags
dflags
      args1 :: [Option]
args1 = [Option]
args0 [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv ([Option]
args0[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++[Option]
args)
  DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered DynFlags
dflags String -> String
forall a. a -> a
id "Make DLL" String
p [Option]
args1 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env

runWindres :: DynFlags -> [Option] -> IO ()
runWindres :: DynFlags -> [Option] -> IO ()
runWindres dflags :: DynFlags
dflags args :: [Option]
args = do
  let (gcc :: String
gcc, gcc_args :: [Option]
gcc_args) = DynFlags -> (String, [Option])
pgm_c 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)
      quote :: String -> String
quote x :: String
x = "\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\""
      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...
              String -> Option
Option ("--preprocessor=" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quote (String
gcc String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
                                          (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
showOpt [Option]
gcc_args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                          (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
showOpt [Option]
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                          ["-E", "-xc", "-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]
: String -> Option
Option "--use-temp-file"
            Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
args
  Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
gcc_args
  DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered DynFlags
dflags String -> String
forall a. a -> a
id "Windres" String
windres [Option]
args' Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env

touch :: DynFlags -> String -> String -> IO ()
touch :: DynFlags -> String -> String -> IO ()
touch dflags :: DynFlags
dflags purpose :: String
purpose arg :: String
arg =
  DynFlags -> String -> String -> [Option] -> IO ()
runSomething DynFlags
dflags String
purpose (DynFlags -> String
pgm_T DynFlags
dflags) [String -> String -> Option
FileOption "" String
arg]