module Distribution.Simple.GHC (
getGhcInfo,
configure,
getInstalledPackages,
getInstalledPackagesMonitorFiles,
getPackageDBContents,
buildLib, buildFLib, buildExe,
replLib, replFLib, replExe,
startInterpreter,
installLib, installFLib, installExe,
libAbiHash,
hcPkgInfo,
registerPackage,
componentGhcOptions,
componentCcGhcOptions,
getLibDir,
isDynamic,
getGlobalPackageDB,
pkgRoot,
Internal.GhcEnvironmentFileEntry(..),
Internal.simpleGhcEnvironmentFile,
Internal.renderGhcEnvironmentFile,
Internal.writeGhcEnvironmentFile,
Internal.ghcPlatformAndVersionString,
readGhcEnvironmentFile,
parseGhcEnvironmentFile,
ParseErrorExc(..),
getImplInfo,
GhcImplInfo(..)
) where
import Prelude ()
import Distribution.Compat.Prelude
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.GHC.ImplInfo
import Distribution.Simple.GHC.EnvironmentParser
import Distribution.PackageDescription.Utils (cabalBug)
import Distribution.PackageDescription as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentLocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Program
import Distribution.Simple.Program.Builtin (runghcProgram)
import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import qualified Distribution.Simple.Program.Strip as Strip
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
import qualified Distribution.Simple.Setup as Cabal
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Version
import Distribution.System
import Distribution.Verbosity
import Distribution.Pretty
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
import Distribution.Types.ForeignLibOption
import Distribution.Types.UnqualComponentName
import Distribution.Utils.NubList
import Language.Haskell.Extension
import Control.Monad (msum, forM_)
import Data.Char (isLower)
import qualified Data.Map as Map
import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing
, canonicalizePath, removeFile, renameFile, getDirectoryContents )
import System.FilePath ( (</>), (<.>), takeExtension
, takeDirectory, replaceExtension
,isRelative )
import qualified System.Info
#ifndef mingw32_HOST_OS
import System.Posix (createSymbolicLink)
#endif /* mingw32_HOST_OS */
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure verbosity hcPath hcPkgPath conf0 = do
(ghcProg, ghcVersion, progdb1) <-
requireProgramVersion verbosity ghcProgram
(orLaterVersion (mkVersion [7,0,1]))
(userMaybeSpecifyPath "ghc" hcPath conf0)
let implInfo = ghcVersionImplInfo ghcVersion
unless (ghcVersion < mkVersion [8,10]) $
warn verbosity $
"Unknown/unsupported 'ghc' version detected "
++ "(Cabal " ++ prettyShow cabalVersion ++ " supports 'ghc' version < 8.10): "
++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion
(ghcPkgProg, ghcPkgVersion, progdb2) <-
requireProgramVersion verbosity ghcPkgProgram {
programFindLocation = guessGhcPkgFromGhcPath ghcProg
}
anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)
when (ghcVersion /= ghcPkgVersion) $ die' verbosity $
"Version mismatch between ghc and ghc-pkg: "
++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion ++ " "
++ programPath ghcPkgProg ++ " is version " ++ prettyShow ghcPkgVersion
let hsc2hsProgram' = hsc2hsProgram {
programFindLocation = guessHsc2hsFromGhcPath ghcProg
}
haddockProgram' = haddockProgram {
programFindLocation = guessHaddockFromGhcPath ghcProg
}
hpcProgram' = hpcProgram {
programFindLocation = guessHpcFromGhcPath ghcProg
}
runghcProgram' = runghcProgram {
programFindLocation = guessRunghcFromGhcPath ghcProg
}
progdb3 = addKnownProgram haddockProgram' $
addKnownProgram hsc2hsProgram' $
addKnownProgram hpcProgram' $
addKnownProgram runghcProgram' progdb2
languages <- Internal.getLanguages verbosity implInfo ghcProg
extensions0 <- Internal.getExtensions verbosity implInfo ghcProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
let ghcInfoMap = Map.fromList ghcInfo
extensions =
filterExt JavaScriptFFI $
filterExtTH $ extensions0
filterExtTH | ghcVersion < mkVersion [8]
, Just "NO" <- Map.lookup "Have interpreter" ghcInfoMap
= filterExt TemplateHaskell
| otherwise = id
filterExt ext = filter ((/= EnableExtension ext) . fst)
let comp = Compiler {
compilerId = CompilerId GHC ghcVersion,
compilerAbiTag = NoAbiTag,
compilerCompat = [],
compilerLanguages = languages,
compilerExtensions = extensions,
compilerProperties = ghcInfoMap
}
compPlatform = Internal.targetPlatform ghcInfo
progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3
return (comp, compPlatform, progdb4)
guessToolFromGhcPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessToolFromGhcPath tool ghcProg verbosity searchpath
= do let toolname = programName tool
given_path = programPath ghcProg
given_dir = takeDirectory given_path
real_path <- canonicalizePath given_path
let real_dir = takeDirectory real_path
versionSuffix path = takeVersionSuffix (dropExeExtension path)
given_suf = versionSuffix given_path
real_suf = versionSuffix real_path
guessNormal dir = dir </> toolname <.> exeExtension buildPlatform
guessGhcVersioned dir suf = dir </> (toolname ++ "-ghc" ++ suf)
<.> exeExtension buildPlatform
guessVersioned dir suf = dir </> (toolname ++ suf)
<.> exeExtension buildPlatform
mkGuesses dir suf | null suf = [guessNormal dir]
| otherwise = [guessGhcVersioned dir suf,
guessVersioned dir suf,
guessNormal dir]
guesses = mkGuesses given_dir given_suf ++
if real_path == given_path
then []
else mkGuesses real_dir real_suf
info verbosity $ "looking for tool " ++ toolname
++ " near compiler in " ++ given_dir
debug verbosity $ "candidate locations: " ++ show guesses
exists <- traverse doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
[] -> programFindLocation tool verbosity searchpath
(fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
let lookedAt = map fst
. takeWhile (\(_file, exist) -> not exist)
$ zip guesses exists
return (Just (fp, lookedAt))
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = takeWhileEndLE isSuffixChar
isSuffixChar :: Char -> Bool
isSuffixChar c = isDigit c || c == '.' || c == '-'
guessGhcPkgFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
guessHsc2hsFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
guessHaddockFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHaddockFromGhcPath = guessToolFromGhcPath haddockProgram
guessHpcFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessHpcFromGhcPath = guessToolFromGhcPath hpcProgram
guessRunghcFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe (FilePath, [FilePath]))
guessRunghcFromGhcPath = guessToolFromGhcPath runghcProgram
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
where
Just version = programVersion ghcProg
implInfo = ghcVersionImplInfo version
getPackageDBContents :: Verbosity -> PackageDB -> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents verbosity packagedb progdb = do
pkgss <- getInstalledPackages' verbosity [packagedb] progdb
toPackageIndex verbosity pkgss progdb
getInstalledPackages :: Verbosity -> Compiler -> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages verbosity comp packagedbs progdb = do
checkPackageDbEnvVar verbosity
checkPackageDbStack verbosity comp packagedbs
pkgss <- getInstalledPackages' verbosity packagedbs progdb
index <- toPackageIndex verbosity pkgss progdb
return $! hackRtsPackage index
where
hackRtsPackage index =
case PackageIndex.lookupPackageName index (mkPackageName "rts") of
[(_,[rts])]
-> PackageIndex.insert (removeMingwIncludeDir rts) index
_ -> index
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramDb
-> IO InstalledPackageIndex
toPackageIndex verbosity pkgss progdb = do
topDir <- getLibDir' verbosity ghcProg
let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! mconcat indices
where
Just ghcProg = lookupProgram ghcProgram progdb
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity lbi =
dropWhileEndLE isSpace `fmap`
getDbProgramOutput verbosity ghcProgram
(withPrograms lbi) ["--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
getProgramOutput verbosity ghcProg ["--print-libdir"]
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
getProgramOutput verbosity ghcProg ["--print-global-package-db"]
getUserPackageDB
:: Verbosity -> ConfiguredProgram -> Platform -> NoCallStackIO FilePath
getUserPackageDB _verbosity ghcProg platform = do
appdir <- getAppUserDataDirectory "ghc"
return (appdir </> platformAndVersion </> packageConfFileName)
where
platformAndVersion = Internal.ghcPlatformAndVersionString
platform ghcVersion
packageConfFileName = "package.conf.d"
Just ghcVersion = programVersion ghcProg
checkPackageDbEnvVar :: Verbosity -> IO ()
checkPackageDbEnvVar verbosity =
Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH"
checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()
checkPackageDbStack verbosity comp =
if flagPackageConf implInfo
then checkPackageDbStackPre76 verbosity
else checkPackageDbStackPost76 verbosity
where implInfo = ghcVersionImplInfo (compilerVersion comp)
checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStackPost76 _ (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStackPost76 verbosity rest
| GlobalPackageDB `elem` rest =
die' verbosity $ "If the global package db is specified, it must be "
++ "specified first and cannot be specified multiple times"
checkPackageDbStackPost76 _ _ = return ()
checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()
checkPackageDbStackPre76 _ (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStackPre76 verbosity rest
| GlobalPackageDB `notElem` rest =
die' verbosity $
"With current ghc versions the global package db is always used "
++ "and must be listed first. This ghc limitation is lifted in GHC 7.6,"
++ "see http://ghc.haskell.org/trac/ghc/ticket/5977"
checkPackageDbStackPre76 verbosity _ =
die' verbosity $ "If the global package db is specified, it must be "
++ "specified first and cannot be specified multiple times"
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir pkg =
let ids = InstalledPackageInfo.includeDirs pkg
ids' = filter (not . ("mingw" `isSuffixOf`)) ids
in pkg { InstalledPackageInfo.includeDirs = ids' }
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramDb
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs progdb =
sequenceA
[ do pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs ]
getInstalledPackagesMonitorFiles :: Verbosity -> Platform
-> ProgramDb
-> [PackageDB]
-> IO [FilePath]
getInstalledPackagesMonitorFiles verbosity platform progdb =
traverse getPackageDBPath
where
getPackageDBPath :: PackageDB -> IO FilePath
getPackageDBPath GlobalPackageDB =
selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg
getPackageDBPath UserPackageDB =
selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform
getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path
selectMonitorFile path = do
isFileStyle <- doesFileExist path
if isFileStyle then return path
else return (path </> "package.cache")
Just ghcProg = lookupProgram ghcProgram progdb
buildLib :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib = buildOrReplLib Nothing
replLib :: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library
-> ComponentLocalBuildInfo -> IO ()
replLib = buildOrReplLib . Just
buildOrReplLib :: Maybe [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Library
-> ComponentLocalBuildInfo -> IO ()
buildOrReplLib mReplFlags verbosity numJobs pkg_descr lbi lib clbi = do
let uid = componentUnitId clbi
libTargetDir = componentBuildDir lbi clbi
whenVanillaLib forceVanilla =
when (forceVanilla || withVanillaLib lbi)
whenProfLib = when (withProfLib lbi)
whenSharedLib forceShared =
when (forceShared || withSharedLib lbi)
whenStaticLib forceStatic =
when (forceStatic || withStaticLib lbi)
whenGHCiLib = when (withGHCiLib lbi)
forRepl = maybe False (const True) mReplFlags
ifReplLib = when forRepl
replFlags = fromMaybe mempty mReplFlags
comp = compiler lbi
ghcVersion = compilerVersion comp
implInfo = getImplInfo comp
platform@(Platform _hostArch hostOS) = hostPlatform lbi
has_code = not (componentIsIndefinite clbi)
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg comp platform
let libBi = libBuildInfo lib
let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = usesTemplateHaskellOrQQ libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
let isCoverageEnabled = libCoverage lbi
pkg_name = prettyShow (PD.package pkg_descr)
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| forRepl = mempty
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
let cLikeFiles = fromNubListR $ mconcat
[ toNubListR (cSources libBi)
, toNubListR (cxxSources libBi)
, toNubListR (cmmSources libBi)
, toNubListR (asmSources libBi)
]
cObjs = map (`replaceExtension` objExtension) cLikeFiles
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = numJobs,
ghcOptInputModules = toNubListR $ allLibModules lib clbi,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = vanillaOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag True
(withProfLibDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = hcProfOptions GHC libBi,
ghcOptHPCDir = hpcdir Hpc.Prof
}
sharedOpts = vanillaOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = hcSharedOptions GHC libBi,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = PD.ldOptions libBi
++ [ "-static"
| withFullyStaticExe lbi ]
++ maybe [] programOverrideArgs
(lookupProgram ldProgram (withPrograms lbi)),
ghcOptLinkLibs = extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
ghcOptLinkFrameworkDirs = toNubListR $
PD.extraFrameworkDirs libBi,
ghcOptInputFiles = toNubListR
[libTargetDir </> x | x <- cObjs]
}
replOpts = vanillaOpts {
ghcOptExtra = Internal.filterGhciFlags
(ghcOptExtra vanillaOpts)
<> replFlags,
ghcOptNumJobs = mempty
}
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
vanillaSharedOpts = vanillaOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
ghcOptDynHiSuffix = toFlag "dyn_hi",
ghcOptDynObjSuffix = toFlag "dyn_o",
ghcOptHPCDir = hpcdir Hpc.Dyn
}
unless (forRepl || null (allLibModules lib clbi)) $
do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
shared = whenSharedLib forceSharedLib (runGhcProg sharedOpts)
useDynToo = dynamicTooSupported &&
(forceVanillaLib || withVanillaLib lbi) &&
(forceSharedLib || withSharedLib lbi) &&
null (hcSharedOptions GHC libBi)
if not has_code
then vanilla
else
if useDynToo
then do
runGhcProg vanillaSharedOpts
case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
(Cabal.Flag dynDir, Cabal.Flag vanillaDir) ->
copyDirectoryRecursive verbosity dynDir vanillaDir
_ -> return ()
else if isGhcDynamic
then do shared; vanilla
else do vanilla; shared
whenProfLib (runGhcProg profOpts)
unless (not has_code || null (cxxSources libBi)) $ do
info verbosity "Building C++ Sources..."
sequence_
[ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo
lbi libBi clbi libTargetDir filename
vanillaCxxOpts = if isGhcDynamic
then baseCxxOpts { ghcOptFPic = toFlag True }
else baseCxxOpts
profCxxOpts = vanillaCxxOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
}
sharedCxxOpts = vanillaCxxOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptObjSuffix = toFlag "dyn_o"
}
odir = fromFlag (ghcOptObjDir vanillaCxxOpts)
createDirectoryIfMissingVerbose verbosity True odir
let runGhcProgIfNeeded cxxOpts = do
needsRecomp <- checkNeedsRecompilation filename cxxOpts
when needsRecomp $ runGhcProg cxxOpts
runGhcProgIfNeeded vanillaCxxOpts
unless forRepl $
whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCxxOpts)
unless forRepl $ whenProfLib (runGhcProgIfNeeded profCxxOpts)
| filename <- cxxSources libBi]
ifReplLib $ do
when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
ifReplLib (runGhcProg replOpts)
unless (not has_code || null (cSources libBi)) $ do
info verbosity "Building C Sources..."
sequence_
[ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo
lbi libBi clbi libTargetDir filename
vanillaCcOpts = if isGhcDynamic
then baseCcOpts { ghcOptFPic = toFlag True }
else baseCcOpts
profCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
}
sharedCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptObjSuffix = toFlag "dyn_o"
}
odir = fromFlag (ghcOptObjDir vanillaCcOpts)
createDirectoryIfMissingVerbose verbosity True odir
let runGhcProgIfNeeded ccOpts = do
needsRecomp <- checkNeedsRecompilation filename ccOpts
when needsRecomp $ runGhcProg ccOpts
runGhcProgIfNeeded vanillaCcOpts
unless forRepl $
whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCcOpts)
unless forRepl $ whenProfLib (runGhcProgIfNeeded profCcOpts)
| filename <- cSources libBi]
unless (not has_code || null (asmSources libBi)) $ do
info verbosity "Building Assembler Sources..."
sequence_
[ do let baseAsmOpts = Internal.componentAsmGhcOptions verbosity implInfo
lbi libBi clbi libTargetDir filename
vanillaAsmOpts = if isGhcDynamic
then baseAsmOpts { ghcOptFPic = toFlag True }
else baseAsmOpts
profAsmOpts = vanillaAsmOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
}
sharedAsmOpts = vanillaAsmOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptObjSuffix = toFlag "dyn_o"
}
odir = fromFlag (ghcOptObjDir vanillaAsmOpts)
createDirectoryIfMissingVerbose verbosity True odir
let runGhcProgIfNeeded asmOpts = do
needsRecomp <- checkNeedsRecompilation filename asmOpts
when needsRecomp $ runGhcProg asmOpts
runGhcProgIfNeeded vanillaAsmOpts
unless forRepl $
whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedAsmOpts)
unless forRepl $ whenProfLib (runGhcProgIfNeeded profAsmOpts)
| filename <- asmSources libBi]
unless (not has_code || null (cmmSources libBi)) $ do
info verbosity "Building C-- Sources..."
sequence_
[ do let baseCmmOpts = Internal.componentCmmGhcOptions verbosity implInfo
lbi libBi clbi libTargetDir filename
vanillaCmmOpts = if isGhcDynamic
then baseCmmOpts { ghcOptFPic = toFlag True }
else baseCmmOpts
profCmmOpts = vanillaCmmOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptObjSuffix = toFlag "p_o"
}
sharedCmmOpts = vanillaCmmOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptObjSuffix = toFlag "dyn_o"
}
odir = fromFlag (ghcOptObjDir vanillaCmmOpts)
createDirectoryIfMissingVerbose verbosity True odir
let runGhcProgIfNeeded cmmOpts = do
needsRecomp <- checkNeedsRecompilation filename cmmOpts
when needsRecomp $ runGhcProg cmmOpts
runGhcProgIfNeeded vanillaCmmOpts
unless forRepl $
whenSharedLib forceSharedLib (runGhcProgIfNeeded sharedCmmOpts)
unless forRepl $ whenProfLib (runGhcProgIfNeeded profCmmOpts)
| filename <- cmmSources libBi]
when has_code . unless forRepl $ do
info verbosity "Linking..."
let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension))
(cSources libBi ++ cxxSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi ++ cxxSources libBi)
compiler_id = compilerId (compiler lbi)
vanillaLibFilePath = libTargetDir </> mkLibName uid
profileLibFilePath = libTargetDir </> mkProfLibName uid
sharedLibFilePath = libTargetDir </>
mkSharedLibName (hostPlatform lbi) compiler_id uid
staticLibFilePath = libTargetDir </>
mkStaticLibName (hostPlatform lbi) compiler_id uid
ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName uid
ghciProfLibFilePath = libTargetDir </> Internal.mkGHCiProfLibName uid
libInstallPath = libdir $
absoluteComponentInstallDirs
pkg_descr lbi uid NoCopyDest
sharedLibInstallPath = libInstallPath </>
mkSharedLibName (hostPlatform lbi) compiler_id uid
stubObjs <- catMaybes <$> sequenceA
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < mkVersion [7,2]
, x <- allLibModules lib clbi ]
stubProfObjs <- catMaybes <$> sequenceA
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < mkVersion [7,2]
, x <- allLibModules lib clbi ]
stubSharedObjs <- catMaybes <$> sequenceA
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < mkVersion [7,2]
, x <- allLibModules lib clbi ]
hObjs <- Internal.getHaskellObjects implInfo lib lbi clbi
libTargetDir objExtension True
hProfObjs <-
if withProfLib lbi
then Internal.getHaskellObjects implInfo lib lbi clbi
libTargetDir ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if withSharedLib lbi
then Internal.getHaskellObjects implInfo lib lbi clbi
libTargetDir ("dyn_" ++ objExtension) False
else return []
unless (null hObjs && null cObjs && null stubObjs) $ do
rpaths <- getRPaths lbi clbi
let staticObjectFiles =
hObjs
++ map (libTargetDir </>) cObjs
++ stubObjs
profObjectFiles =
hProfObjs
++ map (libTargetDir </>) cProfObjs
++ stubProfObjs
dynamicObjectFiles =
hSharedObjs
++ map (libTargetDir </>) cSharedObjs
++ stubSharedObjs
ghcSharedLinkArgs =
mempty {
ghcOptShared = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
ghcOptExtra = hcSharedOptions GHC libBi,
ghcOptDylibName = if hostOS == OSX
&& ghcVersion < mkVersion [7,8]
then toFlag sharedLibInstallPath
else mempty,
ghcOptHideAllPackages = toFlag True,
ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptThisUnitId = case clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo
{ componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag (componentComponentId clbi)
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo
{ componentInstantiatedWith = insts }
-> insts
_ -> [],
ghcOptPackages = toNubListR $
Internal.mkGhcOptPackages clbi ,
ghcOptLinkLibs = extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi,
ghcOptRPaths = rpaths
}
ghcStaticLinkArgs =
mempty {
ghcOptStaticLib = toFlag True,
ghcOptInputFiles = toNubListR staticObjectFiles,
ghcOptOutputFile = toFlag staticLibFilePath,
ghcOptExtra = hcStaticOptions GHC libBi,
ghcOptHideAllPackages = toFlag True,
ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptThisUnitId = case clbi of
LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo
{ componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag (componentComponentId clbi)
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo
{ componentInstantiatedWith = insts }
-> insts
_ -> [],
ghcOptPackages = toNubListR $
Internal.mkGhcOptPackages clbi ,
ghcOptLinkLibs = extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
whenVanillaLib False $ do
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles verbosity lbi ldProg
ghciLibFilePath staticObjectFiles
whenProfLib $ do
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles verbosity lbi ldProg
ghciProfLibFilePath profObjectFiles
whenSharedLib False $
runGhcProg ghcSharedLinkArgs
whenStaticLib False $
runGhcProg ghcStaticLinkArgs
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
-> PackageDBStack -> IO ()
startInterpreter verbosity progdb comp platform packageDBs = do
let replOpts = mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptPackageDBs = packageDBs
}
checkPackageDbStack verbosity comp packageDBs
(ghcProg, _) <- requireProgram verbosity ghcProgram progdb
runGHC verbosity ghcProg comp platform replOpts
buildFLib
:: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> ForeignLib -> ComponentLocalBuildInfo -> IO ()
buildFLib v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildFLib
replFLib
:: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> ForeignLib
-> ComponentLocalBuildInfo -> IO ()
replFLib replFlags v njobs pkg lbi =
gbuild v njobs pkg lbi . GReplFLib replFlags
buildExe
:: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe v njobs pkg lbi = gbuild v njobs pkg lbi . GBuildExe
replExe
:: [String] -> Verbosity
-> Cabal.Flag (Maybe Int) -> PackageDescription
-> LocalBuildInfo -> Executable
-> ComponentLocalBuildInfo -> IO ()
replExe replFlags v njobs pkg lbi =
gbuild v njobs pkg lbi . GReplExe replFlags
data GBuildMode =
GBuildExe Executable
| GReplExe [String] Executable
| GBuildFLib ForeignLib
| GReplFLib [String] ForeignLib
gbuildInfo :: GBuildMode -> BuildInfo
gbuildInfo (GBuildExe exe) = buildInfo exe
gbuildInfo (GReplExe _ exe) = buildInfo exe
gbuildInfo (GBuildFLib flib) = foreignLibBuildInfo flib
gbuildInfo (GReplFLib _ flib) = foreignLibBuildInfo flib
gbuildName :: GBuildMode -> String
gbuildName (GBuildExe exe) = unUnqualComponentName $ exeName exe
gbuildName (GReplExe _ exe) = unUnqualComponentName $ exeName exe
gbuildName (GBuildFLib flib) = unUnqualComponentName $ foreignLibName flib
gbuildName (GReplFLib _ flib) = unUnqualComponentName $ foreignLibName flib
gbuildTargetName :: LocalBuildInfo -> GBuildMode -> String
gbuildTargetName lbi (GBuildExe exe) = exeTargetName (hostPlatform lbi) exe
gbuildTargetName lbi (GReplExe _ exe) = exeTargetName (hostPlatform lbi) exe
gbuildTargetName lbi (GBuildFLib flib) = flibTargetName lbi flib
gbuildTargetName lbi (GReplFLib _ flib) = flibTargetName lbi flib
exeTargetName :: Platform -> Executable -> String
exeTargetName platform exe = unUnqualComponentName (exeName exe) `withExt` exeExtension platform
flibTargetName :: LocalBuildInfo -> ForeignLib -> String
flibTargetName lbi flib =
case (os, foreignLibType flib) of
(Windows, ForeignLibNativeShared) -> nm <.> "dll"
(Windows, ForeignLibNativeStatic) -> nm <.> "lib"
(Linux, ForeignLibNativeShared) -> "lib" ++ nm <.> versionedExt
(_other, ForeignLibNativeShared) ->
"lib" ++ nm <.> dllExtension (hostPlatform lbi)
(_other, ForeignLibNativeStatic) ->
"lib" ++ nm <.> staticLibExtension (hostPlatform lbi)
(_any, ForeignLibTypeUnknown) -> cabalBug "unknown foreign lib type"
where
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
os :: OS
os = let (Platform _ os') = hostPlatform lbi
in os'
versionedExt :: String
versionedExt =
let nums = foreignLibVersion flib os
in foldl (<.>) "so" (map show nums)
flibBuildName :: LocalBuildInfo -> ForeignLib -> String
flibBuildName lbi flib
| (os, foreignLibType flib) ==
(Linux, ForeignLibNativeShared)
= let nums = foreignLibVersion flib os
in "lib" ++ nm <.> foldl (<.>) "so" (map show (take 1 nums))
| otherwise = flibTargetName lbi flib
where
os :: OS
os = let (Platform _ os') = hostPlatform lbi
in os'
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
gbuildIsRepl :: GBuildMode -> Bool
gbuildIsRepl (GBuildExe _) = False
gbuildIsRepl (GReplExe _ _) = True
gbuildIsRepl (GBuildFLib _) = False
gbuildIsRepl (GReplFLib _ _) = True
gbuildNeedDynamic :: LocalBuildInfo -> GBuildMode -> Bool
gbuildNeedDynamic lbi bm =
case bm of
GBuildExe _ -> withDynExe lbi
GReplExe _ _ -> withDynExe lbi
GBuildFLib flib -> withDynFLib flib
GReplFLib _ flib -> withDynFLib flib
where
withDynFLib flib =
case foreignLibType flib of
ForeignLibNativeShared ->
ForeignLibStandalone `notElem` foreignLibOptions flib
ForeignLibNativeStatic ->
False
ForeignLibTypeUnknown ->
cabalBug "unknown foreign lib type"
gbuildModDefFiles :: GBuildMode -> [FilePath]
gbuildModDefFiles (GBuildExe _) = []
gbuildModDefFiles (GReplExe _ _) = []
gbuildModDefFiles (GBuildFLib flib) = foreignLibModDefFile flib
gbuildModDefFiles (GReplFLib _ flib) = foreignLibModDefFile flib
exeMainModuleName :: Executable -> Maybe ModuleName
exeMainModuleName Executable{buildInfo = bnfo} =
msum $ reverse $ map decodeMainIsArg $ findIsMainArgs ghcopts
where
ghcopts = hcOptions GHC bnfo
findIsMainArgs [] = []
findIsMainArgs ("-main-is":arg:rest) = arg : findIsMainArgs rest
findIsMainArgs (_:rest) = findIsMainArgs rest
decodeMainIsArg :: String -> Maybe ModuleName
decodeMainIsArg arg
| not (null main_fn) && isLower (head main_fn)
= Just (ModuleName.fromString main_mod)
| isUpper (head arg)
= Just (ModuleName.fromString arg)
| otherwise
= Nothing
where
(main_mod, main_fn) = splitLongestPrefix arg (== '.')
splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
splitLongestPrefix str pred'
| null r_pre = (str, [])
| otherwise = (reverse (tail r_pre), reverse r_suf)
where (r_suf, r_pre) = break pred' (reverse str)
data BuildSources = BuildSources {
cSourcesFiles :: [FilePath],
cxxSourceFiles :: [FilePath],
inputSourceFiles :: [FilePath],
inputSourceModules :: [ModuleName]
}
gbuildSources :: Verbosity
-> Version
-> FilePath
-> GBuildMode
-> IO BuildSources
gbuildSources verbosity specVer tmpDir bm =
case bm of
GBuildExe exe -> exeSources exe
GReplExe _ exe -> exeSources exe
GBuildFLib flib -> return $ flibSources flib
GReplFLib _ flib -> return $ flibSources flib
where
exeSources :: Executable -> IO BuildSources
exeSources exe@Executable{buildInfo = bnfo, modulePath = modPath} = do
main <- findFileEx verbosity (tmpDir : hsSourceDirs bnfo) modPath
let mainModName = fromMaybe ModuleName.main $ exeMainModuleName exe
otherModNames = exeModules exe
if isHaskell main
then
if specVer < mkVersion [2] && (mainModName `elem` otherModNames)
then do
warn verbosity $ "Enabling workaround for Main module '"
++ prettyShow mainModName
++ "' listed in 'other-modules' illegally!"
return BuildSources {
cSourcesFiles = cSources bnfo,
cxxSourceFiles = cxxSources bnfo,
inputSourceFiles = [main],
inputSourceModules = filter (/= mainModName) $
exeModules exe
}
else return BuildSources {
cSourcesFiles = cSources bnfo,
cxxSourceFiles = cxxSources bnfo,
inputSourceFiles = [main],
inputSourceModules = exeModules exe
}
else let (csf, cxxsf)
| isCxx main = ( cSources bnfo, main : cxxSources bnfo)
| otherwise = (main : cSources bnfo, cxxSources bnfo)
in return BuildSources {
cSourcesFiles = csf,
cxxSourceFiles = cxxsf,
inputSourceFiles = [],
inputSourceModules = exeModules exe
}
flibSources :: ForeignLib -> BuildSources
flibSources flib@ForeignLib{foreignLibBuildInfo = bnfo} =
BuildSources {
cSourcesFiles = cSources bnfo,
cxxSourceFiles = cxxSources bnfo,
inputSourceFiles = [],
inputSourceModules = foreignLibModules flib
}
isHaskell :: FilePath -> Bool
isHaskell fp = elem (takeExtension fp) [".hs", ".lhs"]
isCxx :: FilePath -> Bool
isCxx fp = elem (takeExtension fp) [".cpp", ".cxx", ".c++"]
gbuild :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> GBuildMode -> ComponentLocalBuildInfo -> IO ()
gbuild verbosity numJobs pkg_descr lbi bm clbi = do
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let replFlags = case bm of
GReplExe flags _ -> flags
GReplFLib flags _ -> flags
GBuildExe{} -> mempty
GBuildFLib{} -> mempty
comp = compiler lbi
platform = hostPlatform lbi
implInfo = getImplInfo comp
runGhcProg = runGHC verbosity ghcProg comp platform
let (bnfo, threaded) = case bm of
GBuildFLib _ -> popThreadedFlag (gbuildInfo bm)
_ -> (gbuildInfo bm, False)
let targetName = gbuildTargetName lbi bm
let targetDir = buildDir lbi </> (gbuildName bm)
let tmpDir = targetDir </> (gbuildName bm ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True tmpDir
let isCoverageEnabled = exeCoverage lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| gbuildIsRepl bm = mempty
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way (gbuildName bm)
| otherwise = mempty
rpaths <- getRPaths lbi clbi
buildSources <- gbuildSources verbosity (specVersion pkg_descr) tmpDir bm
let cSrcs = cSourcesFiles buildSources
cxxSrcs = cxxSourceFiles buildSources
inputFiles = inputSourceFiles buildSources
inputModules = inputSourceModules buildSources
isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
cObjs = map (`replaceExtension` objExtension) cSrcs
cxxObjs = map (`replaceExtension` objExtension) cxxSrcs
needDynamic = gbuildNeedDynamic lbi bm
needProfiling = withProfExe lbi
baseOpts = (componentGhcOptions verbosity lbi bnfo clbi tmpDir)
`mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptInputFiles = toNubListR inputFiles,
ghcOptInputModules = toNubListR inputModules
}
staticOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticOnly,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = baseOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag False
(withProfExeDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = hcProfOptions GHC bnfo,
ghcOptHPCDir = hpcdir Hpc.Prof
}
dynOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = hcSharedOptions GHC bnfo,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
dynTooOpts = staticOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticAndDynamic,
ghcOptDynHiSuffix = toFlag "dyn_hi",
ghcOptDynObjSuffix = toFlag "dyn_o",
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = PD.ldOptions bnfo
++ [ "-static"
| withFullyStaticExe lbi ]
++ maybe [] programOverrideArgs
(lookupProgram ldProgram (withPrograms lbi)),
ghcOptLinkLibs = extraLibs bnfo,
ghcOptLinkLibPath = toNubListR $ extraLibDirs bnfo,
ghcOptLinkFrameworks = toNubListR $
PD.frameworks bnfo,
ghcOptLinkFrameworkDirs = toNubListR $
PD.extraFrameworkDirs bnfo,
ghcOptInputFiles = toNubListR
[tmpDir </> x | x <- cObjs ++ cxxObjs]
}
dynLinkerOpts = mempty {
ghcOptRPaths = rpaths
}
replOpts = baseOpts {
ghcOptExtra = Internal.filterGhciFlags
(ghcOptExtra baseOpts)
<> replFlags
}
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
commonOpts | needProfiling = profOpts
| needDynamic = dynOpts
| otherwise = staticOpts
compileOpts | useDynToo = dynTooOpts
| otherwise = commonOpts
withStaticExe = not needProfiling && not needDynamic
doingTH = usesTemplateHaskellOrQQ bnfo
useDynToo = dynamicTooSupported && isGhcDynamic
&& doingTH && withStaticExe
&& null (hcSharedOptions GHC bnfo)
compileTHOpts | isGhcDynamic = dynOpts
| otherwise = staticOpts
compileForTH
| gbuildIsRepl bm = False
| useDynToo = False
| isGhcDynamic = doingTH && (needProfiling || withStaticExe)
| otherwise = doingTH && (needProfiling || needDynamic)
when compileForTH $
runGhcProg compileTHOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless ((null inputFiles && null inputModules)
|| gbuildIsRepl bm) $
runGhcProg compileOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless (null cxxSrcs) $ do
info verbosity "Building C++ Sources..."
sequence_
[ do let baseCxxOpts = Internal.componentCxxGhcOptions verbosity implInfo
lbi bnfo clbi tmpDir filename
vanillaCxxOpts = if isGhcDynamic
then baseCxxOpts { ghcOptFPic = toFlag True }
else baseCxxOpts
profCxxOpts = vanillaCxxOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True
}
sharedCxxOpts = vanillaCxxOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly
}
opts | needProfiling = profCxxOpts
| needDynamic = sharedCxxOpts
| otherwise = vanillaCxxOpts
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True odir
needsRecomp <- checkNeedsRecompilation filename opts
when needsRecomp $
runGhcProg opts
| filename <- cxxSrcs ]
unless (null cSrcs) $ do
info verbosity "Building C Sources..."
sequence_
[ do let baseCcOpts = Internal.componentCcGhcOptions verbosity implInfo
lbi bnfo clbi tmpDir filename
vanillaCcOpts = if isGhcDynamic
then baseCcOpts { ghcOptFPic = toFlag True }
else baseCcOpts
profCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True
}
sharedCcOpts = vanillaCcOpts `mappend` mempty {
ghcOptFPic = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly
}
opts | needProfiling = profCcOpts
| needDynamic = sharedCcOpts
| otherwise = vanillaCcOpts
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True odir
needsRecomp <- checkNeedsRecompilation filename opts
when needsRecomp $
runGhcProg opts
| filename <- cSrcs ]
case bm of
GReplExe _ _ -> runGhcProg replOpts
GReplFLib _ _ -> runGhcProg replOpts
GBuildExe _ -> do
let linkOpts = commonOpts
`mappend` linkerOpts
`mappend` mempty {
ghcOptLinkNoHsMain = toFlag (null inputFiles)
}
`mappend` (if withDynExe lbi then dynLinkerOpts else mempty)
info verbosity "Linking..."
let target = targetDir </> targetName
when (compilerVersion comp < mkVersion [7,7]) $ do
e <- doesFileExist target
when e (removeFile target)
runGhcProg linkOpts { ghcOptOutputFile = toFlag target }
GBuildFLib flib -> do
let rtsInfo = extractRtsInfo lbi
rtsOptLinkLibs = [
if needDynamic
then if threaded
then dynRtsThreadedLib (rtsDynamicInfo rtsInfo)
else dynRtsVanillaLib (rtsDynamicInfo rtsInfo)
else if threaded
then statRtsThreadedLib (rtsStaticInfo rtsInfo)
else statRtsVanillaLib (rtsStaticInfo rtsInfo)
]
linkOpts = case foreignLibType flib of
ForeignLibNativeShared ->
commonOpts
`mappend` linkerOpts
`mappend` dynLinkerOpts
`mappend` mempty {
ghcOptLinkNoHsMain = toFlag True,
ghcOptShared = toFlag True,
ghcOptLinkLibs = rtsOptLinkLibs,
ghcOptLinkLibPath = toNubListR $ rtsLibPaths rtsInfo,
ghcOptFPic = toFlag True,
ghcOptLinkModDefFiles = toNubListR $ gbuildModDefFiles bm
}
`mappend` ifNeedsRPathWorkaround lbi mempty {
ghcOptLinkOptions = ["-Wl,--no-as-needed"]
, ghcOptLinkLibs = ["ffi"]
}
ForeignLibNativeStatic ->
cabalBug "static libraries not yet implemented"
ForeignLibTypeUnknown ->
cabalBug "unknown foreign lib type"
info verbosity "Linking..."
let buildName = flibBuildName lbi flib
runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> buildName) }
renameFile (targetDir </> buildName) (targetDir </> targetName)
ifNeedsRPathWorkaround :: Monoid a => LocalBuildInfo -> a -> a
ifNeedsRPathWorkaround lbi a =
case hostPlatform lbi of
Platform _ Linux -> a
_otherwise -> mempty
data DynamicRtsInfo = DynamicRtsInfo {
dynRtsVanillaLib :: FilePath
, dynRtsThreadedLib :: FilePath
, dynRtsDebugLib :: FilePath
, dynRtsEventlogLib :: FilePath
, dynRtsThreadedDebugLib :: FilePath
, dynRtsThreadedEventlogLib :: FilePath
}
data StaticRtsInfo = StaticRtsInfo {
statRtsVanillaLib :: FilePath
, statRtsThreadedLib :: FilePath
, statRtsDebugLib :: FilePath
, statRtsEventlogLib :: FilePath
, statRtsThreadedDebugLib :: FilePath
, statRtsThreadedEventlogLib :: FilePath
, statRtsProfilingLib :: FilePath
, statRtsThreadedProfilingLib :: FilePath
}
data RtsInfo = RtsInfo {
rtsDynamicInfo :: DynamicRtsInfo
, rtsStaticInfo :: StaticRtsInfo
, rtsLibPaths :: [FilePath]
}
extractRtsInfo :: LocalBuildInfo -> RtsInfo
extractRtsInfo lbi =
case PackageIndex.lookupPackageName
(installedPkgs lbi) (mkPackageName "rts") of
[(_, [rts])] -> aux rts
_otherwise -> error "No (or multiple) ghc rts package is registered"
where
aux :: InstalledPackageInfo -> RtsInfo
aux rts = RtsInfo {
rtsDynamicInfo = DynamicRtsInfo {
dynRtsVanillaLib = withGhcVersion "HSrts"
, dynRtsThreadedLib = withGhcVersion "HSrts_thr"
, dynRtsDebugLib = withGhcVersion "HSrts_debug"
, dynRtsEventlogLib = withGhcVersion "HSrts_l"
, dynRtsThreadedDebugLib = withGhcVersion "HSrts_thr_debug"
, dynRtsThreadedEventlogLib = withGhcVersion "HSrts_thr_l"
}
, rtsStaticInfo = StaticRtsInfo {
statRtsVanillaLib = "HSrts"
, statRtsThreadedLib = "HSrts_thr"
, statRtsDebugLib = "HSrts_debug"
, statRtsEventlogLib = "HSrts_l"
, statRtsThreadedDebugLib = "HSrts_thr_debug"
, statRtsThreadedEventlogLib = "HSrts_thr_l"
, statRtsProfilingLib = "HSrts_p"
, statRtsThreadedProfilingLib = "HSrts_thr_p"
}
, rtsLibPaths = InstalledPackageInfo.libraryDirs rts
}
withGhcVersion = (++ ("-ghc" ++ prettyShow (compilerVersion (compiler lbi))))
checkNeedsRecompilation :: FilePath -> GhcOptions -> NoCallStackIO Bool
checkNeedsRecompilation filename opts = filename `moreRecentFile` oname
where oname = getObjectFileName filename opts
getObjectFileName :: FilePath -> GhcOptions -> FilePath
getObjectFileName filename opts = oname
where odir = fromFlag (ghcOptObjDir opts)
oext = fromFlagOrDefault "o" (ghcOptObjSuffix opts)
oname = odir </> replaceExtension filename oext
getRPaths :: LocalBuildInfo
-> ComponentLocalBuildInfo
-> NoCallStackIO (NubListR FilePath)
getRPaths lbi clbi | supportRPaths hostOS = do
libraryPaths <- depLibraryPaths False (relocatable lbi) lbi clbi
let hostPref = case hostOS of
OSX -> "@loader_path"
_ -> "$ORIGIN"
relPath p = if isRelative p then hostPref </> p else p
rpaths = toNubListR (map relPath libraryPaths)
return rpaths
where
(Platform _ hostOS) = hostPlatform lbi
compid = compilerId . compiler $ lbi
supportRPaths Linux = True
supportRPaths Windows = False
supportRPaths OSX = True
supportRPaths FreeBSD =
case compid of
CompilerId GHC ver | ver >= mkVersion [7,10,2] -> True
_ -> False
supportRPaths OpenBSD = False
supportRPaths NetBSD = False
supportRPaths DragonFly = False
supportRPaths Solaris = False
supportRPaths AIX = False
supportRPaths HPUX = False
supportRPaths IRIX = False
supportRPaths HaLVM = False
supportRPaths IOS = False
supportRPaths Android = False
supportRPaths Ghcjs = False
supportRPaths Hurd = False
supportRPaths (OtherOS _) = False
getRPaths _ _ = return mempty
popThreadedFlag :: BuildInfo -> (BuildInfo, Bool)
popThreadedFlag bi =
( bi { options = filterHcOptions (/= "-threaded") (options bi) }
, hasThreaded (options bi))
where
filterHcOptions :: (String -> Bool)
-> PerCompilerFlavor [String]
-> PerCompilerFlavor [String]
filterHcOptions p (PerCompilerFlavor ghc ghcjs) =
PerCompilerFlavor (filter p ghc) ghcjs
hasThreaded :: PerCompilerFlavor [String] -> Bool
hasThreaded (PerCompilerFlavor ghc _) = elem "-threaded" ghc
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity _pkg_descr lbi lib clbi = do
let
libBi = libBuildInfo lib
comp = compiler lbi
platform = hostPlatform lbi
vanillaArgs0 =
(componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
ghcOptInputModules = toNubListR $ exposedModules lib
}
vanillaArgs =
vanillaArgs0 { ghcOptPackageDBs = [GlobalPackageDB]
, ghcOptPackages = mempty }
sharedArgs = vanillaArgs `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = hcSharedOptions GHC libBi
}
profArgs = vanillaArgs `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptProfilingAuto = Internal.profDetailLevelFlag True
(withProfLibDetail lbi),
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = hcProfOptions GHC libBi
}
ghcArgs
| withVanillaLib lbi = vanillaArgs
| withSharedLib lbi = sharedArgs
| withProfLib lbi = profArgs
| otherwise = error "libAbiHash: Can't find an enabled library way"
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
hash <- getProgramInvocationOutput verbosity
(ghcInvocation ghcProg comp platform ghcArgs)
return (takeWhile (not . isSpace) hash)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions verbosity lbi =
Internal.componentGhcOptions verbosity implInfo lbi
where
comp = compiler lbi
implInfo = getImplInfo comp
componentCcGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo
-> FilePath -> FilePath
-> GhcOptions
componentCcGhcOptions verbosity lbi =
Internal.componentCcGhcOptions verbosity implInfo lbi
where
comp = compiler lbi
implInfo = getImplInfo comp
installExe :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> (FilePath, FilePath)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity lbi binDir buildPref
(progprefix, progsuffix) _pkg exe = do
createDirectoryIfMissingVerbose verbosity True binDir
let exeName' = unUnqualComponentName $ exeName exe
exeFileName = exeTargetName (hostPlatform lbi) exe
fixedExeBaseName = progprefix ++ exeName' ++ progsuffix
installBinary dest = do
installExecutableFile verbosity
(buildPref </> exeName' </> exeFileName)
(dest <.> exeExtension (hostPlatform lbi))
when (stripExes lbi) $
Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi)
(dest <.> exeExtension (hostPlatform lbi))
installBinary (binDir </> fixedExeBaseName)
installFLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> PackageDescription
-> ForeignLib
-> IO ()
installFLib verbosity lbi targetDir builtDir _pkg flib =
install (foreignLibIsShared flib)
builtDir
targetDir
(flibTargetName lbi flib)
where
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True targetDir
if isShared
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
let (Platform _ os) = hostPlatform lbi
when (not (null (foreignLibVersion flib os))) $ do
when (os /= Linux) $ die' verbosity
"Can't install foreign-library symlink on non-Linux OS"
#ifndef mingw32_HOST_OS
withTempDirectory verbosity dstDir nm $ \tmpDir -> do
let link1 = flibBuildName lbi flib
link2 = "lib" ++ nm <.> "so"
createSymbolicLink name (tmpDir </> link1)
renameFile (tmpDir </> link1) (dstDir </> link1)
createSymbolicLink name (tmpDir </> link2)
renameFile (tmpDir </> link2) (dstDir </> link2)
where
nm :: String
nm = unUnqualComponentName $ foreignLibName flib
#endif /* mingw32_HOST_OS */
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
whenVanilla $ copyModuleFiles "hi"
whenProf $ copyModuleFiles "p_hi"
whenShared $ copyModuleFiles "dyn_hi"
whenHasCode $ do
whenVanilla $ do
sequence_ [ installOrdinary
builtDir
targetDir
(mkGenericStaticLibName (l ++ f))
| l <- getHSLibraryName
(componentUnitId clbi):(extraBundledLibs (libBuildInfo lib))
, f <- "":extraLibFlavours (libBuildInfo lib)
]
whenGHCi $ installOrdinary builtDir targetDir ghciLibName
whenProf $ do
installOrdinary builtDir targetDir profileLibName
whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName
whenShared $ if
| specVersion pkg < mkVersion [2,5] -> do
sequence_ [ installShared builtDir dynlibTargetDir
(mkGenericSharedLibName platform compiler_id (l ++ f))
| l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)
, f <- "":extraDynLibFlavours (libBuildInfo lib)
]
| otherwise -> do
sequence_ [ installShared
builtDir
dynlibTargetDir
(mkGenericSharedLibName
platform
compiler_id
(getHSLibraryName uid ++ f))
| f <- "":extraDynLibFlavours (libBuildInfo lib)
]
sequence_ [ do
files <- getDirectoryContents builtDir
let l' = mkGenericSharedBundledLibName
platform
compiler_id
l
forM_ files $ \ file ->
when (l' `isPrefixOf` file) $ do
isFile <- doesFileExist (builtDir </> file)
when isFile $ do
installShared
builtDir
dynlibTargetDir
file
| l <- extraBundledLibs (libBuildInfo lib)
]
where
builtDir = componentBuildDir lbi clbi
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
if isShared
then installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
when (stripLibs lbi) $ Strip.stripLib verbosity
platform (withPrograms lbi) dst
installOrdinary = install False
installShared = install True
copyModuleFiles ext =
findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi)
>>= installOrdinaryFiles verbosity targetDir
compiler_id = compilerId (compiler lbi)
platform = hostPlatform lbi
uid = componentUnitId clbi
profileLibName = mkProfLibName uid
ghciLibName = Internal.mkGHCiLibName uid
ghciProfLibName = Internal.mkGHCiProfLibName uid
hasLib = not $ null (allLibModules lib clbi)
&& null (cSources (libBuildInfo lib))
&& null (cxxSources (libBuildInfo lib))
&& null (cmmSources (libBuildInfo lib))
&& null (asmSources (libBuildInfo lib))
has_code = not (componentIsIndefinite clbi)
whenHasCode = when has_code
whenVanilla = when (hasLib && withVanillaLib lbi)
whenProf = when (hasLib && withProfLib lbi && has_code)
whenGHCi = when (hasLib && withGHCiLib lbi && has_code)
whenShared = when (hasLib && withSharedLib lbi && has_code)
hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo
hcPkgInfo progdb = HcPkg.HcPkgInfo
{ HcPkg.hcPkgProgram = ghcPkgProg
, HcPkg.noPkgDbStack = v < [6,9]
, HcPkg.noVerboseFlag = v < [6,11]
, HcPkg.flagPackageConf = v < [7,5]
, HcPkg.supportsDirDbs = v >= [6,8]
, HcPkg.requiresDirDbs = v >= [7,10]
, HcPkg.nativeMultiInstance = v >= [7,10]
, HcPkg.recacheMultiInstance = v >= [6,12]
, HcPkg.suppressFilesCheck = v >= [6,6]
}
where
v = versionNumbers ver
Just ghcPkgProg = lookupProgram ghcPkgProgram progdb
Just ver = programVersion ghcPkgProg
registerPackage
:: Verbosity
-> ProgramDb
-> PackageDBStack
-> InstalledPackageInfo
-> HcPkg.RegisterOptions
-> IO ()
registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =
HcPkg.register (hcPkgInfo progdb) verbosity packageDbs
installedPkgInfo registerOptions
pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath
pkgRoot verbosity lbi = pkgRoot'
where
pkgRoot' GlobalPackageDB =
let Just ghcProg = lookupProgram ghcProgram (withPrograms lbi)
in fmap takeDirectory (getGlobalPackageDB verbosity ghcProg)
pkgRoot' UserPackageDB = do
appDir <- getAppUserDataDirectory "ghc"
let ver = compilerVersion (compiler lbi)
subdir = System.Info.arch ++ '-':System.Info.os
++ '-':prettyShow ver
rootDir = appDir </> subdir
createDirectoryIfMissing True rootDir
return rootDir
pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
isDynamic :: Compiler -> Bool
isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"
withExt :: FilePath -> String -> FilePath
withExt fp ext = fp <.> if takeExtension fp /= ('.':ext) then ext else ""