{-# LANGUAGE ScopedTypeVariables #-}
module GHC.SysTools.Info where
import GHC.Utils.Exception
import GHC.Utils.Error
import GHC.Driver.Session
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Logger
import Data.List ( isInfixOf, isPrefixOf )
import Data.IORef
import System.IO
import GHC.Platform
import GHC.Prelude
import GHC.SysTools.Process
neededLinkArgs :: LinkerInfo -> [Option]
neededLinkArgs :: LinkerInfo -> [Option]
neededLinkArgs (GnuLD [Option]
o) = [Option]
o
neededLinkArgs (GnuGold [Option]
o) = [Option]
o
neededLinkArgs (LlvmLLD [Option]
o) = [Option]
o
neededLinkArgs (DarwinLD [Option]
o) = [Option]
o
neededLinkArgs (SolarisLD [Option]
o) = [Option]
o
neededLinkArgs (AixLD [Option]
o) = [Option]
o
neededLinkArgs LinkerInfo
UnknownLD = []
getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo Logger
logger DynFlags
dflags = do
Maybe LinkerInfo
info <- forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags)
case Maybe LinkerInfo
info of
Just LinkerInfo
v -> forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
v
Maybe LinkerInfo
Nothing -> do
LinkerInfo
v <- Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo' Logger
logger DynFlags
dflags
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags) (forall a. a -> Maybe a
Just LinkerInfo
v)
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
v
getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo
getLinkerInfo' Logger
logger DynFlags
dflags = do
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
os :: OS
os = Platform -> OS
platformOS Platform
platform
(String
pgm,[Option]
args0) = DynFlags -> (String, [Option])
pgm_l DynFlags
dflags
args1 :: [Option]
args1 = forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (forall a. DynFlags -> (DynFlags -> [a]) -> [a]
getOpts DynFlags
dflags DynFlags -> [String]
opt_l)
args2 :: [Option]
args2 = [Option]
args0 forall a. [a] -> [a] -> [a]
++ [Option]
args1
args3 :: [String]
args3 = forall a. (a -> Bool) -> [a] -> [a]
filter forall (f :: * -> *) a. Foldable f => f a -> Bool
notNull (forall a b. (a -> b) -> [a] -> [b]
map Option -> String
showOpt [Option]
args2)
parseLinkerInfo :: t String -> p -> p -> m LinkerInfo
parseLinkerInfo t String
stdo p
_stde p
_exitc
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU ld" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuLD forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String
"-Wl,--hash-size=31",
String
"-Wl,--reduce-memory-overheads",
String
"-Wl,--no-as-needed"])
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU gold" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuGold [String -> Option
Option String
"-Wl,--no-as-needed"])
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
line -> String
"LLD" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line Bool -> Bool -> Bool
|| String
"LLD" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
words String
line) t String
stdo =
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
LlvmLLD forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [
String
"-Wl,--no-as-needed"])
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid --version output, or linker is unsupported"
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (
case OS
os of
OS
OSSolaris2 ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
SolarisLD []
OS
OSAIX ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
AixLD []
OS
OSDarwin ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
DarwinLD []
OS
OSMinGW32 ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
GnuLD forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option
[
String
"-Wl,--hash-size=31"
, String
"-Wl,--reduce-memory-overheads"
, String
"-fstack-check"
, String
"-static-libgcc" ]
OS
_ -> do
(ExitCode
exitc, String
stdo, String
stde) <- String
-> [String] -> (String, String) -> IO (ExitCode, String, String)
readProcessEnvWithExitCode String
pgm
([String
"-Wl,--version"] forall a. [a] -> [a] -> [a]
++ [String]
args3)
(String, String)
c_locale_env
forall {t :: * -> *} {m :: * -> *} {p} {p}.
(Foldable t, MonadFail m) =>
t String -> p -> p -> m LinkerInfo
parseLinkerInfo (String -> [String]
lines String
stdo) (String -> [String]
lines String
stde) ExitCode
exitc
)
(\IOException
err -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
2
(String -> SDoc
text String
"Error (figuring out linker information):" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text (forall a. Show a => a -> String
show IOException
err))
Logger -> DynFlags -> SDoc -> IO ()
errorMsg Logger
logger DynFlags
dflags forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Warning:") Int
9 forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Couldn't figure out linker information!" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"Make sure you're using GNU ld, GNU gold" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"or the built in OS X linker, etc."
forall (m :: * -> *) a. Monad m => a -> m a
return LinkerInfo
UnknownLD
)
getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo Logger
logger DynFlags
dflags = do
Maybe CompilerInfo
info <- forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo DynFlags
dflags)
case Maybe CompilerInfo
info of
Just CompilerInfo
v -> forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v
Maybe CompilerInfo
Nothing -> do
CompilerInfo
v <- Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo' Logger
logger DynFlags
dflags
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo DynFlags
dflags) (forall a. a -> Maybe a
Just CompilerInfo
v)
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
v
getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo' :: Logger -> DynFlags -> IO CompilerInfo
getCompilerInfo' Logger
logger DynFlags
dflags = do
let pgm :: String
pgm = DynFlags -> String
pgm_c DynFlags
dflags
parseCompilerInfo :: p -> [String] -> p -> m CompilerInfo
parseCompilerInfo p
_stdo [String]
stde p
_exitc
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"gcc version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
GCC
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"clang version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"FreeBSD clang version" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version 5.1" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang51
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple clang version" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"invalid -v output, or compiler is unsupported: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
stde
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (do
(ExitCode
exitc, String
stdo, String
stde) <-
String
-> [String] -> (String, String) -> IO (ExitCode, String, String)
readProcessEnvWithExitCode String
pgm [String
"-v"] (String, String)
c_locale_env
forall {m :: * -> *} {p} {p}.
MonadFail m =>
p -> [String] -> p -> m CompilerInfo
parseCompilerInfo (String -> [String]
lines String
stdo) (String -> [String]
lines String
stde) ExitCode
exitc
)
(\IOException
err -> do
Logger -> DynFlags -> Int -> SDoc -> IO ()
debugTraceMsg Logger
logger DynFlags
dflags Int
2
(String -> SDoc
text String
"Error (figuring out C compiler information):" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text (forall a. Show a => a -> String
show IOException
err))
Logger -> DynFlags -> SDoc -> IO ()
errorMsg Logger
logger DynFlags
dflags forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Warning:") Int
9 forall a b. (a -> b) -> a -> b
$
String -> SDoc
text String
"Couldn't figure out C compiler information!" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"Make sure you're using GNU gcc, or clang"
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
UnknownCC
)