{-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}
module SysTools (
initSysTools,
initLlvmConfig,
module SysTools.Tasks,
module SysTools.Info,
linkDynLib,
copy,
copyWithHeader,
Option(..),
expandTopDir,
libmLinkOpts,
getPkgFrameworkOpts,
getFrameworkOpts
) where
#include "GhclibHsVersions.h"
import GhcPrelude
import Module
import Packages
import Config
import Outputable
import ErrUtils
import Platform
import Util
import DynFlags
import Fingerprint
import System.FilePath
import System.IO
import System.Directory
import SysTools.ExtraObj
import SysTools.Info
import SysTools.Tasks
import SysTools.BaseDir
initLlvmConfig :: String
-> IO LlvmConfig
initLlvmConfig :: String -> IO LlvmConfig
initLlvmConfig String
top_dir
= do
[(String, LlvmTarget)]
targets <- String
-> ((String, String, String) -> LlvmTarget)
-> IO [(String, LlvmTarget)]
forall (f :: * -> *) (f :: * -> *) a b.
(Read (f (f a)), Functor f, Functor f) =>
String -> (a -> b) -> IO (f (f b))
readAndParse String
"llvm-targets" (String, String, String) -> LlvmTarget
mkLlvmTarget
[(Int, String)]
passes <- String -> (String -> String) -> IO [(Int, String)]
forall (f :: * -> *) (f :: * -> *) a b.
(Read (f (f a)), Functor f, Functor f) =>
String -> (a -> b) -> IO (f (f b))
readAndParse String
"llvm-passes" String -> String
forall a. a -> a
id
LlvmConfig -> IO LlvmConfig
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, LlvmTarget)]
targets, [(Int, String)]
passes)
where
readAndParse :: String -> (a -> b) -> IO (f (f b))
readAndParse String
name a -> b
builder =
do let llvmConfigFile :: String
llvmConfigFile = String
top_dir String -> String -> String
</> String
name
String
llvmConfigStr <- String -> IO String
readFile String
llvmConfigFile
case String -> Maybe (f (f a))
forall a. Read a => String -> Maybe a
maybeReadFuzzy String
llvmConfigStr of
Just f (f a)
s -> f (f b) -> IO (f (f b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
builder (f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a)
s)
Maybe (f (f a))
Nothing -> String -> IO (f (f b))
forall a. String -> a
pgmError (String
"Can't parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
llvmConfigFile)
mkLlvmTarget :: (String, String, String) -> LlvmTarget
mkLlvmTarget :: (String, String, String) -> LlvmTarget
mkLlvmTarget (String
dl, String
cpu, String
attrs) = String -> String -> [String] -> LlvmTarget
LlvmTarget String
dl String
cpu (String -> [String]
words String
attrs)
initSysTools :: String
-> IO Settings
initSysTools :: String -> IO Settings
initSysTools String
top_dir
= do
Maybe String
mtool_dir <- String -> IO (Maybe String)
findToolDir String
top_dir
let installed :: FilePath -> FilePath
installed :: String -> String
installed String
file = String
top_dir String -> String -> String
</> String
file
libexec :: FilePath -> FilePath
libexec :: String -> String
libexec String
file = String
top_dir String -> String -> String
</> String
"bin" String -> String -> String
</> String
file
settingsFile :: String
settingsFile = String -> String
installed String
"settings"
platformConstantsFile :: String
platformConstantsFile = String -> String
installed String
"platformConstants"
String
settingsStr <- String -> IO String
readFile String
settingsFile
String
platformConstantsStr <- String -> IO String
readFile String
platformConstantsFile
[(String, String)]
mySettings <- case String -> Maybe [(String, String)]
forall a. Read a => String -> Maybe a
maybeReadFuzzy String
settingsStr of
Just [(String, String)]
s ->
[(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
s
Maybe [(String, String)]
Nothing ->
String -> IO [(String, String)]
forall a. String -> a
pgmError (String
"Can't parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
settingsFile)
PlatformConstants
platformConstants <- case String -> Maybe PlatformConstants
forall a. Read a => String -> Maybe a
maybeReadFuzzy String
platformConstantsStr of
Just PlatformConstants
s ->
PlatformConstants -> IO PlatformConstants
forall (m :: * -> *) a. Monad m => a -> m a
return PlatformConstants
s
Maybe PlatformConstants
Nothing ->
String -> IO PlatformConstants
forall a. String -> a
pgmError (String
"Can't parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> String
forall a. Show a => a -> String
show String
platformConstantsFile)
let getSetting :: String -> m String
getSetting String
key = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key [(String, String)]
mySettings of
Just String
xs -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
expandTopDir String
top_dir String
xs
Maybe String
Nothing -> String -> m String
forall a. String -> a
pgmError (String
"No entry for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
settingsFile)
getToolSetting :: String -> f String
getToolSetting String
key = Maybe String -> String -> String
expandToolDir Maybe String
mtool_dir (String -> String) -> f String -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> f String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
key
getBooleanSetting :: String -> m Bool
getBooleanSetting String
key = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key [(String, String)]
mySettings of
Just String
"YES" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just String
"NO" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just String
xs -> String -> m Bool
forall a. String -> a
pgmError (String
"Bad value for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
xs)
Maybe String
Nothing -> String -> m Bool
forall a. String -> a
pgmError (String
"No entry for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
settingsFile)
readSetting :: String -> m a
readSetting String
key = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key [(String, String)]
mySettings of
Just String
xs ->
case String -> Maybe a
forall a. Read a => String -> Maybe a
maybeRead String
xs of
Just a
v -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Maybe a
Nothing -> String -> m a
forall a. String -> a
pgmError (String
"Failed to read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
xs)
Maybe String
Nothing -> String -> m a
forall a. String -> a
pgmError (String
"No entry for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
settingsFile)
Bool
crossCompiling <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"cross compiling"
Arch
targetArch <- String -> IO Arch
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting String
"target arch"
OS
targetOS <- String -> IO OS
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting String
"target os"
Int
targetWordSize <- String -> IO Int
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting String
"target word size"
Bool
targetUnregisterised <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"Unregisterised"
Bool
targetHasGnuNonexecStack <- String -> IO Bool
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting String
"target has GNU nonexec stack"
Bool
targetHasIdentDirective <- String -> IO Bool
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting String
"target has .ident directive"
Bool
targetHasSubsectionsViaSymbols <- String -> IO Bool
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting String
"target has subsections via symbols"
String
myExtraGccViaCFlags <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"GCC extra via C opts"
String
gcc_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"C compiler command"
String
gcc_args_str <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"C compiler flags"
Bool
gccSupportsNoPie <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"C compiler supports -no-pie"
String
cpp_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"Haskell CPP command"
String
cpp_args_str <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"Haskell CPP flags"
let unreg_gcc_args :: [String]
unreg_gcc_args = if Bool
targetUnregisterised
then [String
"-DNO_REGS", String
"-DUSE_MINIINTERPRETER"]
else []
tntc_gcc_args :: [String]
tntc_gcc_args
| Bool -> Bool
mkTablesNextToCode Bool
targetUnregisterised
= [String
"-DTABLES_NEXT_TO_CODE"]
| Bool
otherwise = []
cpp_args :: [Option]
cpp_args= (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (String -> [String]
words String
cpp_args_str)
gcc_args :: [Option]
gcc_args = (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (String -> [String]
words String
gcc_args_str
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
unreg_gcc_args
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tntc_gcc_args)
Bool
ldSupportsCompactUnwind <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"ld supports compact unwind"
Bool
ldSupportsBuildId <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"ld supports build-id"
Bool
ldSupportsFilelist <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"ld supports filelist"
Bool
ldIsGnuLd <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting String
"ld is GNU ld"
String
perl_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"perl command"
let pkgconfig_path :: String
pkgconfig_path = String -> String
installed String
"package.conf.d"
ghc_usage_msg_path :: String
ghc_usage_msg_path = String -> String
installed String
"ghc-usage.txt"
ghci_usage_msg_path :: String
ghci_usage_msg_path = String -> String
installed String
"ghci-usage.txt"
unlit_path :: String
unlit_path = String -> String
libexec String
cGHC_UNLIT_PGM
split_script :: String
split_script = String -> String
libexec String
cGHC_SPLIT_PGM
String
windres_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"windres command"
String
libtool_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"libtool command"
String
ar_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"ar command"
String
ranlib_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"ranlib command"
String
tmpdir <- IO String
getTemporaryDirectory
String
touch_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"touch command"
let
(String
split_prog, [Option]
split_args)
| Bool
isWindowsHost = (String
perl_path, [String -> Option
Option String
split_script])
| Bool
otherwise = (String
split_script, [])
String
mkdll_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting String
"dllwrap command"
let mkdll_args :: [a]
mkdll_args = []
String
gcc_link_args_str <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"C compiler link flags"
let as_prog :: String
as_prog = String
gcc_prog
as_args :: [Option]
as_args = [Option]
gcc_args
ld_prog :: String
ld_prog = String
gcc_prog
ld_args :: [Option]
ld_args = [Option]
gcc_args [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (String -> [String]
words String
gcc_link_args_str)
String
lc_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"LLVM llc command"
String
lo_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"LLVM opt command"
String
lcc_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting String
"LLVM clang command"
let iserv_prog :: String
iserv_prog = String -> String
libexec String
"ghc-iserv"
let platform :: Platform
platform = Platform :: Arch
-> OS -> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> Platform
Platform {
platformArch :: Arch
platformArch = Arch
targetArch,
platformOS :: OS
platformOS = OS
targetOS,
platformWordSize :: Int
platformWordSize = Int
targetWordSize,
platformUnregisterised :: Bool
platformUnregisterised = Bool
targetUnregisterised,
platformHasGnuNonexecStack :: Bool
platformHasGnuNonexecStack = Bool
targetHasGnuNonexecStack,
platformHasIdentDirective :: Bool
platformHasIdentDirective = Bool
targetHasIdentDirective,
platformHasSubsectionsViaSymbols :: Bool
platformHasSubsectionsViaSymbols = Bool
targetHasSubsectionsViaSymbols,
platformIsCrossCompiling :: Bool
platformIsCrossCompiling = Bool
crossCompiling
}
Settings -> IO Settings
forall (m :: * -> *) a. Monad m => a -> m a
return (Settings -> IO Settings) -> Settings -> IO Settings
forall a b. (a -> b) -> a -> b
$ Settings :: Platform
-> String
-> String
-> Maybe String
-> String
-> String
-> String
-> String
-> [(String, String)]
-> [String]
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> String
-> (String, [Option])
-> String
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> String
-> String
-> String
-> String
-> String
-> (String, [Option])
-> (String, [Option])
-> (String, [Option])
-> String
-> [String]
-> [String]
-> Fingerprint
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> PlatformConstants
-> Settings
Settings {
sTargetPlatform :: Platform
sTargetPlatform = Platform
platform,
sTmpDir :: String
sTmpDir = String -> String
normalise String
tmpdir,
sGhcUsagePath :: String
sGhcUsagePath = String
ghc_usage_msg_path,
sGhciUsagePath :: String
sGhciUsagePath = String
ghci_usage_msg_path,
sToolDir :: Maybe String
sToolDir = Maybe String
mtool_dir,
sTopDir :: String
sTopDir = String
top_dir,
sRawSettings :: [(String, String)]
sRawSettings = [(String, String)]
mySettings,
sExtraGccViaCFlags :: [String]
sExtraGccViaCFlags = String -> [String]
words String
myExtraGccViaCFlags,
sSystemPackageConfig :: String
sSystemPackageConfig = String
pkgconfig_path,
sLdSupportsCompactUnwind :: Bool
sLdSupportsCompactUnwind = Bool
ldSupportsCompactUnwind,
sLdSupportsBuildId :: Bool
sLdSupportsBuildId = Bool
ldSupportsBuildId,
sLdSupportsFilelist :: Bool
sLdSupportsFilelist = Bool
ldSupportsFilelist,
sLdIsGnuLd :: Bool
sLdIsGnuLd = Bool
ldIsGnuLd,
sGccSupportsNoPie :: Bool
sGccSupportsNoPie = Bool
gccSupportsNoPie,
sProgramName :: String
sProgramName = String
"ghc",
sProjectVersion :: String
sProjectVersion = String
cProjectVersion,
sPgm_L :: String
sPgm_L = String
unlit_path,
sPgm_P :: (String, [Option])
sPgm_P = (String
cpp_prog, [Option]
cpp_args),
sPgm_F :: String
sPgm_F = String
"",
sPgm_c :: (String, [Option])
sPgm_c = (String
gcc_prog, [Option]
gcc_args),
sPgm_s :: (String, [Option])
sPgm_s = (String
split_prog,[Option]
split_args),
sPgm_a :: (String, [Option])
sPgm_a = (String
as_prog, [Option]
as_args),
sPgm_l :: (String, [Option])
sPgm_l = (String
ld_prog, [Option]
ld_args),
sPgm_dll :: (String, [Option])
sPgm_dll = (String
mkdll_prog,[Option]
forall a. [a]
mkdll_args),
sPgm_T :: String
sPgm_T = String
touch_path,
sPgm_windres :: String
sPgm_windres = String
windres_path,
sPgm_libtool :: String
sPgm_libtool = String
libtool_path,
sPgm_ar :: String
sPgm_ar = String
ar_path,
sPgm_ranlib :: String
sPgm_ranlib = String
ranlib_path,
sPgm_lo :: (String, [Option])
sPgm_lo = (String
lo_prog,[]),
sPgm_lc :: (String, [Option])
sPgm_lc = (String
lc_prog,[]),
sPgm_lcc :: (String, [Option])
sPgm_lcc = (String
lcc_prog,[]),
sPgm_i :: String
sPgm_i = String
iserv_prog,
sOpt_L :: [String]
sOpt_L = [],
sOpt_P :: [String]
sOpt_P = [],
sOpt_P_fingerprint :: Fingerprint
sOpt_P_fingerprint = Fingerprint
fingerprint0,
sOpt_F :: [String]
sOpt_F = [],
sOpt_c :: [String]
sOpt_c = [],
sOpt_a :: [String]
sOpt_a = [],
sOpt_l :: [String]
sOpt_l = [],
sOpt_windres :: [String]
sOpt_windres = [],
sOpt_lcc :: [String]
sOpt_lcc = [],
sOpt_lo :: [String]
sOpt_lo = [],
sOpt_lc :: [String]
sOpt_lc = [],
sOpt_i :: [String]
sOpt_i = [],
sPlatformConstants :: PlatformConstants
sPlatformConstants = PlatformConstants
platformConstants
}
copy :: DynFlags -> String -> FilePath -> FilePath -> IO ()
copy :: DynFlags -> String -> String -> String -> IO ()
copy DynFlags
dflags String
purpose String
from String
to = DynFlags -> String -> Maybe String -> String -> String -> IO ()
copyWithHeader DynFlags
dflags String
purpose Maybe String
forall a. Maybe a
Nothing String
from String
to
copyWithHeader :: DynFlags -> String -> Maybe String -> FilePath -> FilePath
-> IO ()
DynFlags
dflags String
purpose Maybe String
maybe_header String
from String
to = do
DynFlags -> String -> IO ()
showPass DynFlags
dflags String
purpose
Handle
hout <- String -> IOMode -> IO Handle
openBinaryFile String
to IOMode
WriteMode
Handle
hin <- String -> IOMode -> IO Handle
openBinaryFile String
from IOMode
ReadMode
String
ls <- Handle -> IO String
hGetContents Handle
hin
IO () -> (String -> IO ()) -> Maybe String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Handle -> String -> IO ()
header Handle
hout) Maybe String
maybe_header
Handle -> String -> IO ()
hPutStr Handle
hout String
ls
Handle -> IO ()
hClose Handle
hout
Handle -> IO ()
hClose Handle
hin
where
header :: Handle -> String -> IO ()
header Handle
h String
str = do
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
Handle -> String -> IO ()
hPutStr Handle
h String
str
Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True
linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
linkDynLib :: DynFlags -> [String] -> [InstalledUnitId] -> IO ()
linkDynLib DynFlags
dflags0 [String]
o_files [InstalledUnitId]
dep_packages
= do
let
dflags1 :: DynFlags
dflags1 = if Bool
cGhcThreaded then Way -> DynFlags -> DynFlags
addWay' Way
WayThreaded DynFlags
dflags0
else DynFlags
dflags0
dflags2 :: DynFlags
dflags2 = if Bool
cGhcDebugged then Way -> DynFlags -> DynFlags
addWay' Way
WayDebug DynFlags
dflags1
else DynFlags
dflags1
dflags :: DynFlags
dflags = DynFlags -> DynFlags
updateWays DynFlags
dflags2
verbFlags :: [String]
verbFlags = DynFlags -> [String]
getVerbFlags DynFlags
dflags
o_file :: Maybe String
o_file = DynFlags -> Maybe String
outputFile DynFlags
dflags
[PackageConfig]
pkgs <- DynFlags -> [InstalledUnitId] -> IO [PackageConfig]
getPreloadPackagesAnd DynFlags
dflags [InstalledUnitId]
dep_packages
let pkg_lib_paths :: [String]
pkg_lib_paths = DynFlags -> [PackageConfig] -> [String]
collectLibraryPaths DynFlags
dflags [PackageConfig]
pkgs
let pkg_lib_path_opts :: [String]
pkg_lib_path_opts = (String -> [String]) -> [String] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
get_pkg_lib_path_opts [String]
pkg_lib_paths
get_pkg_lib_path_opts :: String -> [String]
get_pkg_lib_path_opts String
l
| ( OS -> Bool
osElfTarget (Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags)) Bool -> Bool -> Bool
||
OS -> Bool
osMachOTarget (Platform -> OS
platformOS (DynFlags -> Platform
targetPlatform DynFlags
dflags)) ) Bool -> Bool -> Bool
&&
DynFlags -> DynLibLoader
dynLibLoader DynFlags
dflags DynLibLoader -> DynLibLoader -> Bool
forall a. Eq a => a -> a -> Bool
== DynLibLoader
SystemDependent Bool -> Bool -> Bool
&&
Way
WayDyn Way -> [Way] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DynFlags -> [Way]
ways DynFlags
dflags
= [String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l, String
"-Xlinker", String
"-rpath", String
"-Xlinker", String
l]
| Bool
otherwise = [String
"-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l]
let lib_paths :: [String]
lib_paths = DynFlags -> [String]
libraryPaths DynFlags
dflags
let lib_path_opts :: [String]
lib_path_opts = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-L"String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
lib_paths
let platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
os :: OS
os = Platform -> OS
platformOS Platform
platform
pkgs_no_rts :: [PackageConfig]
pkgs_no_rts = case OS
os of
OS
OSMinGW32 ->
[PackageConfig]
pkgs
OS
_ ->
(PackageConfig -> Bool) -> [PackageConfig] -> [PackageConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
rtsUnitId) (UnitId -> Bool)
-> (PackageConfig -> UnitId) -> PackageConfig -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageConfig -> UnitId
packageConfigId) [PackageConfig]
pkgs
let pkg_link_opts :: [String]
pkg_link_opts = let ([String]
package_hs_libs, [String]
extra_libs, [String]
other_flags) = DynFlags -> [PackageConfig] -> ([String], [String], [String])
collectLinkOpts DynFlags
dflags [PackageConfig]
pkgs_no_rts
in [String]
package_hs_libs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
extra_libs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
other_flags
let extra_ld_inputs :: [Option]
extra_ld_inputs = DynFlags -> [Option]
ldInputs DynFlags
dflags
[String]
pkg_framework_opts <- DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
getPkgFrameworkOpts DynFlags
dflags Platform
platform
((PackageConfig -> InstalledUnitId)
-> [PackageConfig] -> [InstalledUnitId]
forall a b. (a -> b) -> [a] -> [b]
map PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId [PackageConfig]
pkgs)
let framework_opts :: [String]
framework_opts = DynFlags -> Platform -> [String]
getFrameworkOpts DynFlags
dflags Platform
platform
case OS
os of
OS
OSMinGW32 -> do
let output_fn :: String
output_fn = case Maybe String
o_file of
Just String
s -> String
s
Maybe String
Nothing -> String
"HSdll.dll"
DynFlags -> [Option] -> IO ()
runLink DynFlags
dflags (
(String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
, String -> Option
Option String
"-shared"
] [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++
[ String -> String -> Option
FileOption String
"-Wl,--out-implib=" (String
output_fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".a")
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SharedImplib DynFlags
dflags
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Option
FileOption String
"") [String]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [String -> Option
Option String
"-Wl,--enable-auto-import"]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option (
[String]
lib_path_opts
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pkg_lib_path_opts
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pkg_link_opts
))
OS
_ | OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin -> do
let output_fn :: String
output_fn = case Maybe String
o_file of { Just String
s -> String
s; Maybe String
Nothing -> String
"a.out"; }
String
instName <- case DynFlags -> Maybe String
dylibInstallName DynFlags
dflags of
Just String
n -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
Maybe String
Nothing -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"@rpath" String -> String -> String
`combine` (String -> String
takeFileName String
output_fn)
DynFlags -> [Option] -> IO ()
runLink DynFlags
dflags (
(String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-dynamiclib"
, String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-undefined",
String -> Option
Option String
"dynamic_lookup",
String -> Option
Option String
"-single_module" ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (if Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64
then [ ]
else [ String -> Option
Option String
"-Wl,-read_only_relocs,suppress" ])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-install_name", String -> Option
Option String
instName ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
framework_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_link_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_framework_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-Wl,-dead_strip_dylibs" ]
)
OS
_ -> do
let output_fn :: String
output_fn = case Maybe String
o_file of { Just String
s -> String
s; Maybe String
Nothing -> String
"a.out"; }
unregisterised :: Bool
unregisterised = Platform -> Bool
platformUnregisterised (DynFlags -> Platform
targetPlatform DynFlags
dflags)
let bsymbolicFlag :: [String]
bsymbolicFlag =
[String
"-Wl,-Bsymbolic" | Bool -> Bool
not Bool
unregisterised]
DynFlags -> [Option] -> IO ()
runLink DynFlags
dflags (
(String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
verbFlags
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
libmLinkOpts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-o"
, String -> String -> Option
FileOption String
"" String
output_fn
]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option String
"-shared" ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
bsymbolicFlag
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option (String
"-Wl,-h," String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
output_fn) ]
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
extra_ld_inputs
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_lib_path_opts
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
Option [String]
pkg_link_opts
)
libmLinkOpts :: [Option]
libmLinkOpts :: [Option]
libmLinkOpts =
#if defined(HAVE_LIBM)
[String -> Option
Option String
"-lm"]
#else
[]
#endif
getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
getPkgFrameworkOpts DynFlags
dflags Platform
platform [InstalledUnitId]
dep_packages
| Platform -> Bool
platformUsesFrameworks Platform
platform = do
[String]
pkg_framework_path_opts <- do
[String]
pkg_framework_paths <- DynFlags -> [InstalledUnitId] -> IO [String]
getPackageFrameworkPath DynFlags
dflags [InstalledUnitId]
dep_packages
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-F" String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
pkg_framework_paths
[String]
pkg_framework_opts <- do
[String]
pkg_frameworks <- DynFlags -> [InstalledUnitId] -> IO [String]
getPackageFrameworks DynFlags
dflags [InstalledUnitId]
dep_packages
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-framework", String
fw] | String
fw <- [String]
pkg_frameworks ]
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
pkg_framework_path_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pkg_framework_opts)
| Bool
otherwise = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getFrameworkOpts :: DynFlags -> Platform -> [String]
getFrameworkOpts :: DynFlags -> Platform -> [String]
getFrameworkOpts DynFlags
dflags Platform
platform
| Platform -> Bool
platformUsesFrameworks Platform
platform = [String]
framework_path_opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
framework_opts
| Bool
otherwise = []
where
framework_paths :: [String]
framework_paths = DynFlags -> [String]
frameworkPaths DynFlags
dflags
framework_path_opts :: [String]
framework_path_opts = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-F" String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
framework_paths
frameworks :: [String]
frameworks = DynFlags -> [String]
cmdlineFrameworks DynFlags
dflags
framework_opts :: [String]
framework_opts = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [String
"-framework", String
fw]
| String
fw <- [String] -> [String]
forall a. [a] -> [a]
reverse [String]
frameworks ]