{-# LANGUAGE CPP, MultiWayIf, ScopedTypeVariables #-}
module SysTools (
initSysTools,
initLlvmConfig,
module SysTools.Tasks,
module SysTools.Info,
linkDynLib,
copy,
copyWithHeader,
Option(..),
expandTopDir,
libmLinkOpts,
getPkgFrameworkOpts,
getFrameworkOpts
) where
#include "HsVersions.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 top_dir :: 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 "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 "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 name :: String
name builder :: 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 s :: 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)
Nothing -> String -> IO (f (f b))
forall a. String -> a
pgmError ("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 (dl :: String
dl, cpu :: String
cpu, attrs :: 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 top_dir :: String
top_dir
= do
Maybe String
mtool_dir <- String -> IO (Maybe String)
findToolDir String
top_dir
let installed :: FilePath -> FilePath
installed :: String -> String
installed file :: String
file = String
top_dir String -> String -> String
</> String
file
libexec :: FilePath -> FilePath
libexec :: String -> String
libexec file :: String
file = String
top_dir String -> String -> String
</> "bin" String -> String -> String
</> String
file
settingsFile :: String
settingsFile = String -> String
installed "settings"
platformConstantsFile :: String
platformConstantsFile = String -> String
installed "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 s :: [(String, String)]
s ->
[(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
s
Nothing ->
String -> IO [(String, String)]
forall a. String -> a
pgmError ("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 s :: PlatformConstants
s ->
PlatformConstants -> IO PlatformConstants
forall (m :: * -> *) a. Monad m => a -> m a
return PlatformConstants
s
Nothing ->
String -> IO PlatformConstants
forall a. String -> a
pgmError ("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 key :: 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 xs :: 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
Nothing -> String -> m String
forall a. String -> a
pgmError ("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]
++ " 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 key :: 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 key :: 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 "YES" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just "NO" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just xs :: String
xs -> String -> m Bool
forall a. String -> a
pgmError ("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
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
xs)
Nothing -> String -> m Bool
forall a. String -> a
pgmError ("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]
++ " 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 key :: 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 xs :: String
xs ->
case String -> Maybe a
forall a. Read a => String -> Maybe a
maybeRead String
xs of
Just v :: a
v -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
Nothing -> String -> m a
forall a. String -> a
pgmError ("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]
++ " value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
xs)
Nothing -> String -> m a
forall a. String -> a
pgmError ("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]
++ " 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 "cross compiling"
Arch
targetArch <- String -> IO Arch
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting "target arch"
OS
targetOS <- String -> IO OS
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting "target os"
Int
targetWordSize <- String -> IO Int
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting "target word size"
Bool
targetUnregisterised <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting "Unregisterised"
Bool
targetHasGnuNonexecStack <- String -> IO Bool
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting "target has GNU nonexec stack"
Bool
targetHasIdentDirective <- String -> IO Bool
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting "target has .ident directive"
Bool
targetHasSubsectionsViaSymbols <- String -> IO Bool
forall a (m :: * -> *). (Read a, Monad m) => String -> m a
readSetting "target has subsections via symbols"
String
myExtraGccViaCFlags <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting "GCC extra via C opts"
String
gcc_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "C compiler command"
String
gcc_args_str <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting "C compiler flags"
Bool
gccSupportsNoPie <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting "C compiler supports -no-pie"
String
cpp_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "Haskell CPP command"
String
cpp_args_str <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting "Haskell CPP flags"
let unreg_gcc_args :: [String]
unreg_gcc_args = if Bool
targetUnregisterised
then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
else []
tntc_gcc_args :: [String]
tntc_gcc_args
| Bool -> Bool
mkTablesNextToCode Bool
targetUnregisterised
= ["-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 "ld supports compact unwind"
Bool
ldSupportsBuildId <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting "ld supports build-id"
Bool
ldSupportsFilelist <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting "ld supports filelist"
Bool
ldIsGnuLd <- String -> IO Bool
forall (m :: * -> *). Monad m => String -> m Bool
getBooleanSetting "ld is GNU ld"
String
perl_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "perl command"
let pkgconfig_path :: String
pkgconfig_path = String -> String
installed "package.conf.d"
ghc_usage_msg_path :: String
ghc_usage_msg_path = String -> String
installed "ghc-usage.txt"
ghci_usage_msg_path :: String
ghci_usage_msg_path = String -> String
installed "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 "windres command"
String
libtool_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "libtool command"
String
ar_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "ar command"
String
ranlib_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "ranlib command"
String
tmpdir <- IO String
getTemporaryDirectory
String
touch_path <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getToolSetting "touch command"
let
(split_prog :: String
split_prog, split_args :: [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 "dllwrap command"
let mkdll_args :: [a]
mkdll_args = []
String
gcc_link_args_str <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting "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 "LLVM llc command"
String
lo_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting "LLVM opt command"
String
lcc_prog <- String -> IO String
forall (m :: * -> *). Monad m => String -> m String
getSetting "LLVM clang command"
let iserv_prog :: String
iserv_prog = String -> String
libexec "ghc-iserv"
let platform :: Platform
platform = $WPlatform :: 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 = "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 = "",
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 dflags :: DynFlags
dflags purpose :: String
purpose from :: String
from to :: 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 ()
dflags :: DynFlags
dflags purpose :: String
purpose maybe_header :: Maybe String
maybe_header from :: String
from to :: 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 h :: Handle
h str :: 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 dflags0 :: DynFlags
dflags0 o_files :: [String]
o_files dep_packages :: [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 l :: 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
= ["-L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l, "-Xlinker", "-rpath", "-Xlinker", String
l]
| Bool
otherwise = ["-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 ("-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
OSMinGW32 ->
[PackageConfig]
pkgs
_ ->
(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 (package_hs_libs :: [String]
package_hs_libs, extra_libs :: [String]
extra_libs, other_flags :: [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
OSMinGW32 -> do
let output_fn :: String
output_fn = case Maybe String
o_file of
Just s :: String
s -> String
s
Nothing -> "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 "-o"
, String -> String -> Option
FileOption "" String
output_fn
, String -> Option
Option "-shared"
] [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++
[ String -> String -> Option
FileOption "-Wl,--out-implib=" (String
output_fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".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]
o_files
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [String -> Option
Option "-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 -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin -> do
let output_fn :: String
output_fn = case Maybe String
o_file of { Just s :: String
s -> String
s; Nothing -> "a.out"; }
String
instName <- case DynFlags -> Maybe String
dylibInstallName DynFlags
dflags of
Just n :: String
n -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
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
$ "@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 "-dynamiclib"
, String -> Option
Option "-o"
, String -> String -> Option
FileOption "" 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 "-undefined",
String -> Option
Option "dynamic_lookup",
String -> Option
Option "-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 "-Wl,-read_only_relocs,suppress" ])
[Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [ String -> Option
Option "-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 "-Wl,-dead_strip_dylibs" ]
)
_ -> do
let output_fn :: String
output_fn = case Maybe String
o_file of { Just s :: String
s -> String
s; Nothing -> "a.out"; }
unregisterised :: Bool
unregisterised = Platform -> Bool
platformUnregisterised (DynFlags -> Platform
targetPlatform DynFlags
dflags)
let bsymbolicFlag :: [String]
bsymbolicFlag =
["-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 "-o"
, String -> String -> Option
FileOption "" 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 "-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 ("-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 "-lm"]
#else
[]
#endif
getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
getPkgFrameworkOpts dflags :: DynFlags
dflags platform :: Platform
platform dep_packages :: [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 ("-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 [ ["-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 dflags :: DynFlags
dflags platform :: 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 ("-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 [ ["-framework", String
fw]
| String
fw <- [String] -> [String]
forall a. [a] -> [a]
reverse [String]
frameworks ]