{-# LANGUAGE ScopedTypeVariables #-}
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 Control.Monad
import Data.List (tails, isPrefixOf)
import Data.Maybe (fromMaybe)
import System.IO
import System.Process
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Errors
import GHC.Driver.Errors.Types (GhcMessage(..), DriverMessage (DriverNoConfiguredLLVMToolchain))
import GHC.Driver.CmdLine (warnsToMessages)
import GHC.Types.SrcLoc (noLoc)
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)
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)
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
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 []
chunkWarnings :: [String]
-> [String]
-> [([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 [] = []
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
data SourceCodePreprocessor
= SCPCpp
| SCPHsCpp
| SCPJsCpp
| SCPCmmCpp
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)
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
program, [Option]
configured_args) = DynFlags -> (String, [Option])
pgm_getter DynFlags
dflags
runtime_args :: [Option]
runtime_args = 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)
extra_warns :: [Option]
extra_warns = [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]
configured_args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
runtime_args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_warns [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv ([Option]
configured_args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
runtime_args)
runSomething readable_name program all_args mb_env
where
toolSettings' :: ToolSettings
toolSettings' = DynFlags -> ToolSettings
toolSettings DynFlags
dflags
cmmG0 :: [String]
cmmG0 = [String
"-g0" | ToolSettings -> Bool
toolSettings_cmmCppSupportsG0 ToolSettings
toolSettings']
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
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)
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
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
runSomethingResponseFile logger tmpfs (tmpDir dflags) cc_filter dbgstring prog args2
mb_env
where
([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")
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)
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
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)
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)
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)
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
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
diag_opts :: DiagOpts
diag_opts = DynFlags -> DiagOpts
initDiagOpts 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)
args' :: [String]
args' = [String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-version"]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pgm) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger
-> GhcMessageOpts -> DiagOpts -> Messages GhcMessage -> IO ()
printOrThrowDiagnostics Logger
logger (DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
dflags) DiagOpts
diag_opts
(DriverMessage -> GhcMessage
GhcDriverMessage (DriverMessage -> GhcMessage)
-> Messages DriverMessage -> Messages GhcMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiagOpts -> [Warn] -> Messages DriverMessage
warnsToMessages DiagOpts
diag_opts [DriverMessage -> Warn
forall e. e -> Located e
noLoc DriverMessage
DriverNoConfiguredLLVMToolchain])
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
hSetBinaryMode pout False
_ <- hGetLine pout
vline <- hGetLine pout
let mb_ver = String -> Maybe LlvmVersion
parseLlvmVersion String
vline
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)
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 {b}. b
err (DynFlags -> Maybe (String, [Option])
pgm_lm DynFlags
dflags)
err :: b
err = GhcException -> b
forall a. GhcException -> a
throwGhcException (GhcException -> b) -> GhcException -> b
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