{-# LANGUAGE ScopedTypeVariables #-}
module GHC.SysTools.Tasks where
import GHC.Prelude
import GHC.Platform
import GHC.ForeignSrcLang
import GHC.IO (catchException)
import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUpperBound, parseLlvmVersion, supportedLlvmVersionLowerBound)
import GHC.Settings
import GHC.SysTools.Process
import GHC.SysTools.Info
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.Constants (isWindowsHost)
import GHC.Utils.Panic
import Data.List (tails, isPrefixOf)
import Data.Maybe (fromMaybe)
import System.IO
import System.Process
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)
runCpp :: Logger -> DynFlags -> [Option] -> IO ()
runCpp :: Logger -> DynFlags -> [Option] -> IO ()
runCpp Logger
logger DynFlags
dflags [Option]
args = Logger -> String -> IO () -> IO ()
forall a. Logger -> String -> IO a -> IO a
traceSystoolCommand Logger
logger String
"cpp" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let opts :: [String]
opts = DynFlags -> (DynFlags -> [String]) -> [String]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [String]
opt_P
modified_imports :: [String]
modified_imports = DynFlags -> [String] -> [String]
augmentImports DynFlags
dflags [String]
opts
let (String
p,[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 [String]
modified_imports
args2 :: [Option]
args2 = [String -> Option
Option String
"-Werror" | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WarnIsError DynFlags
dflags]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [String -> Option
Option String
"-Wundef" | WarningFlag -> DynFlags -> Bool
wopt WarningFlag
Opt_WarnCPPUndef DynFlags
dflags]
Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
Logger
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered Logger
logger String -> String
forall a. a -> a
id String
"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 :: 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
Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
Logger
-> TmpFs
-> DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe [(String, String)]
-> IO ()
runSomethingResponseFile Logger
logger TmpFs
tmpfs DynFlags
dflags String -> String
cc_filter String
dbgstring String
prog [Option]
args2
Maybe [(String, String)]
mb_env
where
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
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
([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
Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
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
"gcc" String
p [Option]
args2 (([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
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
Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
Logger
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered Logger
logger String -> String
forall a. a -> a
id String
"Assembler" String
p [Option]
args2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
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)
runClang :: Logger -> DynFlags -> [Option] -> IO ()
runClang :: Logger -> DynFlags -> [Option] -> IO ()
runClang Logger
logger DynFlags
dflags [Option]
args = Logger -> String -> IO () -> IO ()
forall a. Logger -> String -> IO a -> IO a
traceSystoolCommand Logger
logger String
"clang" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let (String
clang,[Option]
_) = DynFlags -> (String, [Option])
pgm_lcc DynFlags
dflags
(String
_,[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
catchException
(Logger
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered Logger
logger String -> String
forall a. a -> a
id String
"Clang (Assembler)" String
clang [Option]
args2 Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env)
(\(SomeException
err :: SomeException) -> do
Logger -> SDoc -> IO ()
errorMsg Logger
logger (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> SDoc
forall doc. IsLine doc => String -> doc
text (String
"Error running clang! you need clang installed to use the" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" LLVM backend") SDoc -> SDoc -> SDoc
$+$
String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(or GHC tried to execute clang incorrectly)"
SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO SomeException
err
)
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
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"]
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) <- 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
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
ExitCode
_ <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p
Maybe LlvmVersion -> IO (Maybe LlvmVersion)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LlvmVersion
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)
runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runLink Logger
logger TmpFs
tmpfs DynFlags
dflags [Option]
args = Logger -> String -> IO () -> IO ()
forall a. Logger -> String -> IO a -> IO a
traceSystoolCommand Logger
logger String
"linker" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[Option]
linkargs <- LinkerInfo -> [Option]
neededLinkArgs (LinkerInfo -> [Option]) -> IO LinkerInfo -> IO [Option]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo Logger
logger DynFlags
dflags
let (String
p,[Option]
args0) = DynFlags -> (String, [Option])
pgm_l DynFlags
dflags
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_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 [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
Logger
-> TmpFs
-> DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe [(String, String)]
-> IO ()
runSomethingResponseFile Logger
logger TmpFs
tmpfs DynFlags
dflags String -> String
ld_filter String
"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
OS
OSSolaris2 -> String -> String
sunos_ld_filter
OS
_ -> String -> String
forall a. a -> a
id
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' [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 [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 :: [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 String
"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 a. [a] -> 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 String
"Undefined"
ld_warn_break :: [String] -> ([String], [String])
ld_warn_break = String -> [String] -> ([String], [String])
forall {a}. Eq a => [a] -> [[a]] -> ([[a]], [[a]])
breakStartsWith String
"ld: warning: symbol referencing errors"
ld_postfix :: [String] -> [String]
ld_postfix = [String] -> [String]
forall a. HasCallStack => [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 a. [a] -> 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
runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
runMergeObjects Logger
logger TmpFs
tmpfs DynFlags
dflags [Option]
args =
Logger -> String -> IO () -> IO ()
forall a. Logger -> String -> IO a -> IO a
traceSystoolCommand Logger
logger String
"merge-objects" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let (String
p,[Option]
args0) = (String, [Option])
-> Maybe (String, [Option]) -> (String, [Option])
forall a. a -> Maybe a -> a
fromMaybe (String, [Option])
forall {a}. a
err (DynFlags -> Maybe (String, [Option])
pgm_lm DynFlags
dflags)
err :: a
err = GhcException -> a
forall a. GhcException -> a
throwGhcException (GhcException -> a) -> GhcException -> a
forall a b. (a -> b) -> a -> b
$ String -> GhcException
UsageError (String -> GhcException) -> String -> GhcException
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
[ String
"Attempted to merge object files but the configured linker"
, String
"does not support object merging." ]
optl_args :: [Option]
optl_args = (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (DynFlags -> (DynFlags -> [String]) -> [String]
forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [String]
opt_lm)
args2 :: [Option]
args2 = [Option]
args0 [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
optl_args
if Bool
isWindowsHost
then do
Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
args2
Logger
-> TmpFs
-> DynFlags
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe [(String, String)]
-> IO ()
runSomethingResponseFile Logger
logger TmpFs
tmpfs DynFlags
dflags String -> String
forall a. a -> a
id String
"Merge objects" String
p [Option]
args2 Maybe [(String, String)]
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)
Maybe [(String, String)]
mb_env <- [Option] -> IO (Maybe [(String, String)])
getGccEnv [Option]
cc_args
Logger
-> (String -> String)
-> String
-> String
-> [Option]
-> Maybe String
-> Maybe [(String, String)]
-> IO ()
runSomethingFiltered Logger
logger String -> String
forall a. a -> a
id String
"Windres" String
windres ([Option]
opts [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
args) Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
mb_env
touch :: Logger -> DynFlags -> String -> String -> IO ()
touch :: Logger -> DynFlags -> String -> String -> IO ()
touch Logger
logger DynFlags
dflags String
purpose String
arg = Logger -> String -> IO () -> IO ()
forall a. Logger -> String -> IO a -> IO a
traceSystoolCommand Logger
logger String
"touch" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Logger -> String -> String -> [Option] -> IO ()
runSomething Logger
logger String
purpose (DynFlags -> String
pgm_T DynFlags
dflags) [String -> String -> Option
FileOption String
"" String
arg]