{-# 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 <- IORef (Maybe LinkerInfo) -> IO (Maybe LinkerInfo)
forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags)
case Maybe LinkerInfo
info of
Just LinkerInfo
v -> LinkerInfo -> IO LinkerInfo
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
IORef (Maybe LinkerInfo) -> Maybe LinkerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe LinkerInfo)
rtldInfo DynFlags
dflags) (LinkerInfo -> Maybe LinkerInfo
forall a. a -> Maybe a
Just LinkerInfo
v)
LinkerInfo -> IO LinkerInfo
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 = (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
args3 :: [String]
args3 = (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]
args2)
parseLinkerInfo :: t String -> p -> p -> m LinkerInfo
parseLinkerInfo t String
stdo p
_stde p
_exitc
| (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU ld" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
LinkerInfo -> m LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
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"])
| (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"GNU gold" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
LinkerInfo -> m LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
GnuGold [String -> Option
Option String
"-Wl,--no-as-needed"])
| (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"LLD" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) t String
stdo =
LinkerInfo -> m LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ([Option] -> LinkerInfo
LlvmLLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [
String
"-Wl,--no-as-needed"])
| Bool
otherwise = String -> m LinkerInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid --version output, or linker is unsupported"
IO LinkerInfo -> (IOException -> IO LinkerInfo) -> IO LinkerInfo
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO (
case OS
os of
OS
OSSolaris2 ->
LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
SolarisLD []
OS
OSAIX ->
LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
AixLD []
OS
OSDarwin ->
LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
DarwinLD []
OS
OSMinGW32 ->
LinkerInfo -> IO LinkerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LinkerInfo -> IO LinkerInfo) -> LinkerInfo -> IO LinkerInfo
forall a b. (a -> b) -> a -> b
$ [Option] -> LinkerInfo
GnuLD ([Option] -> LinkerInfo) -> [Option] -> LinkerInfo
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
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"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args3)
(String, String)
c_locale_env
[String] -> [String] -> ExitCode -> IO LinkerInfo
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 (IOException -> String
forall a. Show a => a -> String
show IOException
err))
Logger -> DynFlags -> SDoc -> IO ()
errorMsg Logger
logger DynFlags
dflags (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Warning:") Int
9 (SDoc -> SDoc) -> SDoc -> SDoc
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."
LinkerInfo -> IO LinkerInfo
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 <- IORef (Maybe CompilerInfo) -> IO (Maybe CompilerInfo)
forall a. IORef a -> IO a
readIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo DynFlags
dflags)
case Maybe CompilerInfo
info of
Just CompilerInfo
v -> CompilerInfo -> IO CompilerInfo
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
IORef (Maybe CompilerInfo) -> Maybe CompilerInfo -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (DynFlags -> IORef (Maybe CompilerInfo)
rtccInfo DynFlags
dflags) (CompilerInfo -> Maybe CompilerInfo
forall a. a -> Maybe a
Just CompilerInfo
v)
CompilerInfo -> IO CompilerInfo
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
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"gcc version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
GCC
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"clang version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"FreeBSD clang version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) [String]
stde =
CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
Clang
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version 5.1" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang51
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple LLVM version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String
"Apple clang version" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
stde =
CompilerInfo -> m CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
AppleClang
| Bool
otherwise = String -> m CompilerInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m CompilerInfo) -> String -> m CompilerInfo
forall a b. (a -> b) -> a -> b
$ String
"invalid -v output, or compiler is unsupported: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [String]
stde
IO CompilerInfo
-> (IOException -> IO CompilerInfo) -> IO CompilerInfo
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
[String] -> [String] -> ExitCode -> IO CompilerInfo
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 (IOException -> String
forall a. Show a => a -> String
show IOException
err))
Logger -> DynFlags -> SDoc -> IO ()
errorMsg Logger
logger DynFlags
dflags (SDoc -> IO ()) -> SDoc -> IO ()
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Warning:") Int
9 (SDoc -> SDoc) -> SDoc -> SDoc
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"
CompilerInfo -> IO CompilerInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerInfo
UnknownCC
)