Cabal-1.22.2.0: Distribution/Simple/GHC.hs
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC
-- Copyright : Isaac Jones 2003-2007
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
--
-- This is a fairly large module. It contains most of the GHC-specific code for
-- configuring, building and installing packages. It also exports a function
-- for finding out what packages are already installed. Configuring involves
-- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
-- this version of ghc supports and returning a 'Compiler' value.
--
-- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
-- what packages are installed.
--
-- Building is somewhat complex as there is quite a bit of information to take
-- into account. We have to build libs and programs, possibly for profiling and
-- shared libs. We have to support building libraries that will be usable by
-- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
-- using ghc. Linking, especially for @split-objs@ is remarkably complex,
-- partly because there tend to be 1,000's of @.o@ files and this can often be
-- more than we can pass to the @ld@ or @ar@ programs in one go.
--
-- Installing for libs and exes involves finding the right files and copying
-- them to the right places. One of the more tricky things about this module is
-- remembering the layout of files in the build directory (which is not
-- explicitly documented) and thus what search dirs are used for various kinds
-- of files.
module Distribution.Simple.GHC (
getGhcInfo,
configure, getInstalledPackages, getPackageDBContents,
buildLib, buildExe,
replLib, replExe,
startInterpreter,
installLib, installExe,
libAbiHash,
hcPkgInfo,
registerPackage,
componentGhcOptions,
getLibDir,
isDynamic,
getGlobalPackageDB,
pkgRoot
) where
import qualified Distribution.Simple.GHC.IPI641 as IPI641
import qualified Distribution.Simple.GHC.IPI642 as IPI642
import qualified Distribution.Simple.GHC.Internal as Internal
import Distribution.Simple.GHC.ImplInfo
import Distribution.PackageDescription as PD
( PackageDescription(..), BuildInfo(..), Executable(..), Library(..)
, allExtensions, libModules, exeModules
, hcOptions, hcSharedOptions, hcProfOptions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
( InstalledPackageInfo_(..) )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, absoluteInstallDirs, depLibraryPaths )
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import Distribution.Package
( PackageName(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration
, ProgramSearchPath
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, getProgramInvocationOutput, requireProgramVersion, requireProgram
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
, ghcProgram, ghcPkgProgram, hsc2hsProgram, ldProgram )
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
( toFlag, fromFlag, configCoverage, configDistPref )
import qualified Distribution.Simple.Setup as Cabal
( Flag(..) )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, PackageDB(..), PackageDBStack, AbiTag(..) )
import Distribution.Version
( Version(..), anyVersion, orLaterVersion )
import Distribution.System
( Platform(..), OS(..) )
import Distribution.Verbosity
import Distribution.Text
( display )
import Distribution.Utils.NubList
( NubListR, overNubListR, toNubListR )
import Language.Haskell.Extension (Extension(..), KnownExtension(..))
import Control.Monad ( unless, when )
import Data.Char ( isDigit, isSpace )
import Data.List
import qualified Data.Map as M ( fromList )
import Data.Maybe ( catMaybes )
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid ( Monoid(..) )
#endif
import Data.Version ( showVersion )
import System.Directory
( doesFileExist, getAppUserDataDirectory, createDirectoryIfMissing )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension, isRelative )
import qualified System.Info
-- -----------------------------------------------------------------------------
-- Configuring
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
-> ProgramConfiguration
-> IO (Compiler, Maybe Platform, ProgramConfiguration)
configure verbosity hcPath hcPkgPath conf0 = do
(ghcProg, ghcVersion, conf1) <-
requireProgramVersion verbosity ghcProgram
(orLaterVersion (Version [6,4] []))
(userMaybeSpecifyPath "ghc" hcPath conf0)
let implInfo = ghcVersionImplInfo ghcVersion
-- This is slightly tricky, we have to configure ghc first, then we use the
-- location of ghc to help find ghc-pkg in the case that the user did not
-- specify the location of ghc-pkg directly:
(ghcPkgProg, ghcPkgVersion, conf2) <-
requireProgramVersion verbosity ghcPkgProgram {
programFindLocation = guessGhcPkgFromGhcPath ghcProg
}
anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf1)
when (ghcVersion /= ghcPkgVersion) $ die $
"Version mismatch between ghc and ghc-pkg: "
++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " "
++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion
-- Likewise we try to find the matching hsc2hs program.
let hsc2hsProgram' = hsc2hsProgram {
programFindLocation = guessHsc2hsFromGhcPath ghcProg
}
conf3 = addKnownProgram hsc2hsProgram' conf2
languages <- Internal.getLanguages verbosity implInfo ghcProg
extensions <- Internal.getExtensions verbosity implInfo ghcProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
let ghcInfoMap = M.fromList ghcInfo
let comp = Compiler {
compilerId = CompilerId GHC ghcVersion,
compilerAbiTag = NoAbiTag,
compilerCompat = [],
compilerLanguages = languages,
compilerExtensions = extensions,
compilerProperties = ghcInfoMap
}
compPlatform = Internal.targetPlatform ghcInfo
conf4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap conf3 -- configure gcc and ld
return (comp, compPlatform, conf4)
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
-- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
-- for a versioned or unversioned ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessToolFromGhcPath :: Program -> ConfiguredProgram
-> Verbosity -> ProgramSearchPath
-> IO (Maybe FilePath)
guessToolFromGhcPath tool ghcProg verbosity searchpath
= do let toolname = programName tool
path = programPath ghcProg
dir = takeDirectory path
versionSuffix = takeVersionSuffix (dropExeExtension path)
guessNormal = dir </> toolname <.> exeExtension
guessGhcVersioned = dir </> (toolname ++ "-ghc" ++ versionSuffix)
<.> exeExtension
guessVersioned = dir </> (toolname ++ versionSuffix)
<.> exeExtension
guesses | null versionSuffix = [guessNormal]
| otherwise = [guessGhcVersioned,
guessVersioned,
guessNormal]
info verbosity $ "looking for tool " ++ toolname
++ " near compiler in " ++ dir
exists <- mapM doesFileExist guesses
case [ file | (file, True) <- zip guesses exists ] of
-- If we can't find it near ghc, fall back to the usual
-- method.
[] -> programFindLocation tool verbosity searchpath
(fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
return (Just fp)
where takeVersionSuffix :: FilePath -> String
takeVersionSuffix = takeWhileEndLE isSuffixChar
isSuffixChar :: Char -> Bool
isSuffixChar c = isDigit c || c == '.' || c == '-'
dropExeExtension :: FilePath -> FilePath
dropExeExtension filepath =
case splitExtension filepath of
(filepath', extension) | extension == exeExtension -> filepath'
| otherwise -> filepath
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding ghc-pkg, we try looking for both a versioned and unversioned
-- ghc-pkg in the same dir, that is:
--
-- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
-- > /usr/local/bin/ghc-pkg(.exe)
--
guessGhcPkgFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
-- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
-- corresponding hsc2hs, we try looking for both a versioned and unversioned
-- hsc2hs in the same dir, that is:
--
-- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs-6.6.1(.exe)
-- > /usr/local/bin/hsc2hs(.exe)
--
guessHsc2hsFromGhcPath :: ConfiguredProgram
-> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo verbosity ghcProg = Internal.getGhcInfo verbosity implInfo ghcProg
where
Just version = programVersion ghcProg
implInfo = ghcVersionImplInfo version
-- | Given a single package DB, return all installed packages.
getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration
-> IO InstalledPackageIndex
getPackageDBContents verbosity packagedb conf = do
pkgss <- getInstalledPackages' verbosity [packagedb] conf
toPackageIndex verbosity pkgss conf
-- | Given a package DB stack, return all installed packages.
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
-> IO InstalledPackageIndex
getInstalledPackages verbosity packagedbs conf = do
checkPackageDbEnvVar
checkPackageDbStack packagedbs
pkgss <- getInstalledPackages' verbosity packagedbs conf
index <- toPackageIndex verbosity pkgss conf
return $! hackRtsPackage index
where
hackRtsPackage index =
case PackageIndex.lookupPackageName index (PackageName "rts") of
[(_,[rts])]
-> PackageIndex.insert (removeMingwIncludeDir rts) index
_ -> index -- No (or multiple) ghc rts package is registered!!
-- Feh, whatever, the ghc test suite does some crazy stuff.
-- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
-- @PackageIndex@. Helper function used by 'getPackageDBContents' and
-- 'getInstalledPackages'.
toPackageIndex :: Verbosity
-> [(PackageDB, [InstalledPackageInfo])]
-> ProgramConfiguration
-> IO InstalledPackageIndex
toPackageIndex verbosity pkgss conf = do
-- On Windows, various fields have $topdir/foo rather than full
-- paths. We need to substitute the right value in so that when
-- we, for example, call gcc, we have proper paths to give it.
topDir <- getLibDir' verbosity ghcProg
let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! (mconcat indices)
where
Just ghcProg = lookupProgram ghcProgram conf
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity lbi =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdoutConf verbosity ghcProgram
(withPrograms lbi) ["--print-libdir"]
getLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
getLibDir' verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-libdir"]
-- | Return the 'FilePath' to the global GHC package database.
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"]
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar =
Internal.checkPackageDbEnvVar "GHC" "GHC_PACKAGE_PATH"
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
| GlobalPackageDB `notElem` rest = return ()
checkPackageDbStack rest
| GlobalPackageDB `notElem` rest =
die $ "With current ghc versions the global package db is always used "
++ "and must be listed first. This ghc limitation may be lifted in "
++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977"
checkPackageDbStack _ =
die $ "If the global package db is specified, it must be "
++ "specified first and cannot be specified multiple times"
-- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
-- breaks when you want to use a different gcc, so we need to filter
-- it out.
removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
removeMingwIncludeDir pkg =
let ids = InstalledPackageInfo.includeDirs pkg
ids' = filter (not . ("mingw" `isSuffixOf`)) ids
in pkg { InstalledPackageInfo.includeDirs = ids' }
-- | Get the packages from specific PackageDBs, not cumulative.
--
getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
-> IO [(PackageDB, [InstalledPackageInfo])]
getInstalledPackages' verbosity packagedbs conf
| ghcVersion >= Version [6,9] [] =
sequence
[ do pkgs <- HcPkg.dump (hcPkgInfo conf) verbosity packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs ]
where
Just ghcProg = lookupProgram ghcProgram conf
Just ghcVersion = programVersion ghcProg
getInstalledPackages' verbosity packagedbs conf = do
str <- rawSystemProgramStdoutConf verbosity ghcPkgProgram conf ["list"]
let pkgFiles = [ init line | line <- lines str, last line == ':' ]
dbFile packagedb = case (packagedb, pkgFiles) of
(GlobalPackageDB, global:_) -> return $ Just global
(UserPackageDB, _global:user:_) -> return $ Just user
(UserPackageDB, _global:_) -> return $ Nothing
(SpecificPackageDB specific, _) -> return $ Just specific
_ -> die "cannot read ghc-pkg package listing"
pkgFiles' <- mapM dbFile packagedbs
sequence [ withFileContents file $ \content -> do
pkgs <- readPackages file content
return (db, pkgs)
| (db , Just file) <- zip packagedbs pkgFiles' ]
where
-- Depending on the version of ghc we use a different type's Read
-- instance to parse the package file and then convert.
-- It's a bit yuck. But that's what we get for using Read/Show.
readPackages
| ghcVersion >= Version [6,4,2] []
= \file content -> case reads content of
[(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
_ -> failToRead file
| otherwise
= \file content -> case reads content of
[(pkgs, _)] -> return (map IPI641.toCurrent pkgs)
_ -> failToRead file
Just ghcProg = lookupProgram ghcProgram conf
Just ghcVersion = programVersion ghcProg
failToRead file = die $ "cannot read ghc package database " ++ file
-- -----------------------------------------------------------------------------
-- Building
-- | Build a library with GHC.
--
buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib = buildOrReplLib False
replLib = buildOrReplLib True
buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
libName <- case componentLibraries clbi of
[libName] -> return libName
[] -> die "No library name found when building library"
_ -> die "Multiple library names found when building library"
let libTargetDir = buildDir lbi
whenVanillaLib forceVanilla =
when (forceVanilla || withVanillaLib lbi)
whenProfLib = when (withProfLib lbi)
whenSharedLib forceShared =
when (forceShared || withSharedLib lbi)
whenGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi)
ifReplLib = when forRepl
comp = compiler lbi
ghcVersion = compilerVersion comp
implInfo = getImplInfo comp
(Platform _hostArch hostOS) = hostPlatform lbi
hole_insts = map (\(k,(p,n)) -> (k,(InstalledPackageInfo.packageKey p,n))) (instantiatedWith lbi)
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg comp
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
-- TH always needs default libs, even when building for profiling
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
-- Component name. Not 'libName' because that has the "HS" prefix
-- that GHC gives Haskell libraries.
cname = display $ PD.package $ localPkgDescr lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way cname
| otherwise = mempty
createDirectoryIfMissingVerbose verbosity True libTargetDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules?
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = numJobs,
ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptSigOf = hole_insts,
ghcOptInputModules = toNubListR $ libModules lib,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = vanillaOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ 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 = toNubListR $ hcSharedOptions GHC libBi,
ghcOptHPCDir = hpcdir Hpc.Dyn
}
linkerOpts = mempty {
ghcOptLinkOptions = toNubListR $ PD.ldOptions libBi,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
ghcOptInputFiles = toNubListR
[libTargetDir </> x | x <- cObjs]
}
replOpts = vanillaOpts {
ghcOptExtra = overNubListR
Internal.filterGhciFlags $
(ghcOptExtra vanillaOpts),
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 (libModules lib)) $
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 useDynToo
then do
runGhcProg vanillaSharedOpts
case (hpcdir Hpc.Dyn, hpcdir Hpc.Vanilla) of
(Cabal.Flag dynDir, Cabal.Flag vanillaDir) -> do
-- When the vanilla and shared library builds are done
-- in one pass, only one set of HPC module interfaces
-- are generated. This set should suffice for both
-- static and dynamically linked executables. We copy
-- the modules interfaces so they are available under
-- both ways.
copyDirectoryRecursive verbosity dynDir vanillaDir
_ -> return ()
else if isGhcDynamic
then do shared; vanilla
else do vanilla; shared
whenProfLib (runGhcProg profOpts)
-- build any C sources
unless (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
-- Dynamic GHC requires C sources to be built
-- with -fPIC for REPL to work. See #2207.
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
runGhcProg vanillaCcOpts
unless forRepl $
whenSharedLib forceSharedLib (runGhcProg sharedCcOpts)
unless forRepl $ whenProfLib (runGhcProg profCcOpts)
| filename <- cSources libBi]
-- TODO: problem here is we need the .c files built first, so we can load them
-- with ghci, but .c files can depend on .h files generated by ghc by ffi
-- exports.
unless (null (libModules lib)) $
ifReplLib (runGhcProg replOpts)
-- link:
unless forRepl $ do
info verbosity "Linking..."
let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension))
(cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi)
cid = compilerId (compiler lbi)
vanillaLibFilePath = libTargetDir </> mkLibName libName
profileLibFilePath = libTargetDir </> mkProfLibName libName
sharedLibFilePath = libTargetDir </> mkSharedLibName cid libName
ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName libName
libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest
sharedLibInstallPath = libInstallPath </> mkSharedLibName cid libName
stubObjs <- fmap catMaybes $ sequence
[ findFileWithExtension [objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
stubProfObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
stubSharedObjs <- fmap catMaybes $ sequence
[ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
(ModuleName.toFilePath x ++"_stub")
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
hObjs <- Internal.getHaskellObjects implInfo lib lbi
libTargetDir objExtension True
hProfObjs <-
if (withProfLib lbi)
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if (withSharedLib lbi)
then Internal.getHaskellObjects implInfo lib lbi
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
ghciObjFiles =
hObjs
++ map (libTargetDir </>) cObjs
++ stubObjs
dynamicObjectFiles =
hSharedObjs
++ map (libTargetDir </>) cSharedObjs
++ stubSharedObjs
-- After the relocation lib is created we invoke ghc -shared
-- with the dependencies spelled out as -package arguments
-- and ghc invokes the linker with the proper library paths
ghcSharedLinkArgs =
mempty {
ghcOptShared = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
-- For dynamic libs, Mac OS/X needs to know the install location
-- at build time. This only applies to GHC < 7.8 - see the
-- discussion in #1660.
ghcOptDylibName = if (hostOS == OSX
&& ghcVersion < Version [7,8] [])
then toFlag sharedLibInstallPath
else mempty,
ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptNoAutoLinkPackages = toFlag True,
ghcOptPackageDBs = withPackageDB lbi,
ghcOptPackages = toNubListR $
Internal.mkGhcOptPackages clbi ,
ghcOptLinkLibs = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptRPaths = rpaths
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
whenVanillaLib False $ do
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
whenProfLib $ do
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles verbosity ldProg
ghciLibFilePath ghciObjFiles
whenSharedLib False $
runGhcProg ghcSharedLinkArgs
-- | Start a REPL without loading any source files.
startInterpreter :: Verbosity -> ProgramConfiguration -> Compiler
-> PackageDBStack -> IO ()
startInterpreter verbosity conf comp packageDBs = do
let replOpts = mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptPackageDBs = packageDBs
}
checkPackageDbStack packageDBs
(ghcProg, _) <- requireProgram verbosity ghcProgram conf
runGHC verbosity ghcProg comp replOpts
-- | Build an executable with GHC.
--
buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe = buildOrReplExe False
replExe = buildOrReplExe True
buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let comp = compiler lbi
implInfo = getImplInfo comp
runGhcProg = runGHC verbosity ghcProg comp
exeBi <- hackThreadedFlag verbosity
comp (withProfExe lbi) (buildInfo exe)
-- exeNameReal, the name that GHC really uses (with .exe on Windows)
let exeNameReal = exeName' <.>
(if takeExtension exeName' /= ('.':exeExtension)
then exeExtension
else "")
let targetDir = (buildDir lbi) </> exeName'
let exeDir = targetDir </> (exeName' ++ "-tmp")
createDirectoryIfMissingVerbose verbosity True targetDir
createDirectoryIfMissingVerbose verbosity True exeDir
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules? FIX: what about exeName.hi-boot?
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way exeName'
| otherwise = mempty
-- build executables
srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath
rpaths <- getRPaths lbi clbi
let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
cSrcs = cSources exeBi ++ [srcMainFile | not isHaskellMain]
cObjs = map (`replaceExtension` objExtension) cSrcs
baseOpts = (componentGhcOptions verbosity lbi exeBi clbi exeDir)
`mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptInputFiles = toNubListR
[ srcMainFile | isHaskellMain],
ghcOptInputModules = toNubListR
[ m | not isHaskellMain, m <- exeModules exe]
}
staticOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcStaticOnly,
ghcOptHPCDir = hpcdir Hpc.Vanilla
}
profOpts = baseOpts `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC exeBi,
ghcOptHPCDir = hpcdir Hpc.Prof
}
dynOpts = baseOpts `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = toNubListR $
hcSharedOptions GHC exeBi,
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 = toNubListR $ PD.ldOptions exeBi,
ghcOptLinkLibs = toNubListR $ extraLibs exeBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs exeBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks exeBi,
ghcOptInputFiles = toNubListR
[exeDir </> x | x <- cObjs],
ghcOptRPaths = rpaths
}
replOpts = baseOpts {
ghcOptExtra = overNubListR
Internal.filterGhciFlags
(ghcOptExtra baseOpts)
}
-- For a normal compile we do separate invocations of ghc for
-- compiling as for linking. But for repl we have to do just
-- the one invocation, so that one has to include all the
-- linker stuff too, like -l flags and any .o files from C
-- files etc.
`mappend` linkerOpts
`mappend` mempty {
ghcOptMode = toFlag GhcModeInteractive,
ghcOptOptimisation = toFlag GhcNoOptimisation
}
commonOpts | withProfExe lbi = profOpts
| withDynExe lbi = dynOpts
| otherwise = staticOpts
compileOpts | useDynToo = dynTooOpts
| otherwise = commonOpts
withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi)
-- For building exe's that use TH with -prof or -dynamic we actually have
-- to build twice, once without -prof/-dynamic and then again with
-- -prof/-dynamic. This is because the code that TH needs to run at
-- compile time needs to be the vanilla ABI so it can be loaded up and run
-- by the compiler.
-- With dynamic-by-default GHC the TH object files loaded at compile-time
-- need to be .dyn_o instead of .o.
doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi
-- Should we use -dynamic-too instead of compiling twice?
useDynToo = dynamicTooSupported && isGhcDynamic
&& doingTH && withStaticExe
&& null (hcSharedOptions GHC exeBi)
compileTHOpts | isGhcDynamic = dynOpts
| otherwise = staticOpts
compileForTH
| forRepl = False
| useDynToo = False
| isGhcDynamic = doingTH && (withProfExe lbi || withStaticExe)
| otherwise = doingTH && (withProfExe lbi || withDynExe lbi)
linkOpts = commonOpts `mappend`
linkerOpts `mappend` mempty {
ghcOptLinkNoHsMain = toFlag (not isHaskellMain)
}
-- Build static/dynamic object files for TH, if needed.
when compileForTH $
runGhcProg compileTHOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
unless forRepl $
runGhcProg compileOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = numJobs }
-- build any C sources
unless (null cSrcs) $ do
info verbosity "Building C Sources..."
sequence_
[ do let opts = (Internal.componentCcGhcOptions verbosity implInfo lbi exeBi
clbi exeDir filename) `mappend` mempty {
ghcOptDynLinkMode = toFlag (if withDynExe lbi
then GhcDynamicOnly
else GhcStaticOnly),
ghcOptProfilingMode = toFlag (withProfExe lbi)
}
odir = fromFlag (ghcOptObjDir opts)
createDirectoryIfMissingVerbose verbosity True odir
runGhcProg opts
| filename <- cSrcs ]
-- TODO: problem here is we need the .c files built first, so we can load them
-- with ghci, but .c files can depend on .h files generated by ghc by ffi
-- exports.
when forRepl $ runGhcProg replOpts
-- link:
unless forRepl $ do
info verbosity "Linking..."
runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> exeNameReal) }
-- | Calculate the RPATHs for the component we are building.
--
-- Calculates relative RPATHs when 'relocatable' is set.
getRPaths :: LocalBuildInfo
-> ComponentLocalBuildInfo -- ^ Component we are building
-> IO (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
-- The list of RPath-supported operating systems below reflects the
-- platforms on which Cabal's RPATH handling is tested. It does _NOT_
-- reflect whether the OS supports RPATH.
-- E.g. when this comment was written, the *BSD operating systems were
-- untested with regards to Cabal RPATH handling, and were hence set to
-- 'False', while those operating systems themselves do support RPATH.
supportRPaths Linux = True
supportRPaths Windows = False
supportRPaths OSX = True
supportRPaths FreeBSD = 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 Ghcjs = False
supportRPaths (OtherOS _) = False
-- Do _not_ add a default case so that we get a warning here when a new OS
-- is added.
getRPaths _ _ = return mempty
-- | Filter the "-threaded" flag when profiling as it does not
-- work with ghc-6.8 and older.
hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo
hackThreadedFlag verbosity comp prof bi
| not mustFilterThreaded = return bi
| otherwise = do
warn verbosity $ "The ghc flag '-threaded' is not compatible with "
++ "profiling in ghc-6.8 and older. It will be disabled."
return bi { options = filterHcOptions (/= "-threaded") (options bi) }
where
mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] []
&& "-threaded" `elem` hcOptions GHC bi
filterHcOptions p hcoptss =
[ (hc, if hc == GHC then filter p opts else opts)
| (hc, opts) <- hcoptss ]
-- | Extracts a String representing a hash of the ABI of a built
-- library. It can fail if the library has not yet been built.
--
libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO String
libAbiHash verbosity _pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let
comp = compiler lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
`mappend` mempty {
ghcOptMode = toFlag GhcModeAbiHash,
ghcOptPackageKey = toFlag (pkgKey lbi),
ghcOptInputModules = toNubListR $ exposedModules lib
}
sharedArgs = vanillaArgs `mappend` mempty {
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptFPic = toFlag True,
ghcOptHiSuffix = toFlag "dyn_hi",
ghcOptObjSuffix = toFlag "dyn_o",
ghcOptExtra = toNubListR $ hcSharedOptions GHC libBi
}
profArgs = vanillaArgs `mappend` mempty {
ghcOptProfilingMode = toFlag True,
ghcOptHiSuffix = toFlag "p_hi",
ghcOptObjSuffix = toFlag "p_o",
ghcOptExtra = toNubListR $ hcProfOptions GHC libBi
}
ghcArgs = if withVanillaLib lbi then vanillaArgs
else if withSharedLib lbi then sharedArgs
else if withProfLib lbi then profArgs
else error "libAbiHash: Can't find an enabled library way"
--
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
hash <- getProgramInvocationOutput verbosity (ghcInvocation ghcProg comp ghcArgs)
return (takeWhile (not . isSpace) hash)
componentGhcOptions :: Verbosity -> LocalBuildInfo
-> BuildInfo -> ComponentLocalBuildInfo -> FilePath
-> GhcOptions
componentGhcOptions = Internal.componentGhcOptions
-- -----------------------------------------------------------------------------
-- Installing
-- |Install executables for GHC.
installExe :: Verbosity
-> LocalBuildInfo
-> InstallDirs FilePath -- ^Where to copy the files to
-> FilePath -- ^Build location
-> (FilePath, FilePath) -- ^Executable (prefix,suffix)
-> PackageDescription
-> Executable
-> IO ()
installExe verbosity lbi installDirs buildPref
(progprefix, progsuffix) _pkg exe = do
let binDir = bindir installDirs
createDirectoryIfMissingVerbose verbosity True binDir
let exeFileName = exeName exe <.> exeExtension
fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix
installBinary dest = do
installExecutableFile verbosity
(buildPref </> exeName exe </> exeFileName)
(dest <.> exeExtension)
when (stripExes lbi) $
Strip.stripExe verbosity (hostPlatform lbi) (withPrograms lbi)
(dest <.> exeExtension)
installBinary (binDir </> fixedExeBaseName)
-- |Install for ghc, .hi, .a and, if --with-ghci given, .o
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath -- ^install location
-> FilePath -- ^install location for dynamic libraries
-> FilePath -- ^Build location
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
-- copy .hi files over:
whenVanilla $ copyModuleFiles "hi"
whenProf $ copyModuleFiles "p_hi"
whenShared $ copyModuleFiles "dyn_hi"
-- copy the built library files over:
whenVanilla $ mapM_ (installOrdinary builtDir targetDir) vanillaLibNames
whenProf $ mapM_ (installOrdinary builtDir targetDir) profileLibNames
whenGHCi $ mapM_ (installOrdinary builtDir targetDir) ghciLibNames
whenShared $ mapM_ (installShared builtDir dynlibTargetDir) sharedLibNames
where
install isShared srcDir dstDir name = do
let src = srcDir </> name
dst = dstDir </> name
createDirectoryIfMissingVerbose verbosity True dstDir
if isShared
then do when (stripLibs lbi) $ Strip.stripLib verbosity
(hostPlatform lbi) (withPrograms lbi) src
installExecutableFile verbosity src dst
else installOrdinaryFile verbosity src dst
installOrdinary = install False
installShared = install True
copyModuleFiles ext =
findModuleFiles [builtDir] [ext] (libModules lib)
>>= installOrdinaryFiles verbosity targetDir
cid = compilerId (compiler lbi)
libNames = componentLibraries clbi
vanillaLibNames = map mkLibName libNames
profileLibNames = map mkProfLibName libNames
ghciLibNames = map Internal.mkGHCiLibName libNames
sharedLibNames = map (mkSharedLibName cid) libNames
hasLib = not $ null (libModules lib)
&& null (cSources (libBuildInfo lib))
whenVanilla = when (hasLib && withVanillaLib lbi)
whenProf = when (hasLib && withProfLib lbi)
whenGHCi = when (hasLib && withGHCiLib lbi)
whenShared = when (hasLib && withSharedLib lbi)
-- -----------------------------------------------------------------------------
-- Registering
hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo
hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram = ghcPkgProg
, HcPkg.noPkgDbStack = v < [6,9]
, HcPkg.noVerboseFlag = v < [6,11]
, HcPkg.flagPackageConf = v < [7,5]
, HcPkg.useSingleFileDb = v < [7,9]
}
where
v = versionBranch ver
Just ghcPkgProg = lookupProgram ghcPkgProgram conf
Just ver = programVersion ghcPkgProg
registerPackage
:: Verbosity
-> InstalledPackageInfo
-> PackageDescription
-> LocalBuildInfo
-> Bool
-> PackageDBStack
-> IO ()
registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity
packageDbs (Right installedPkgInfo)
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 ++ '-':showVersion ver
rootDir = appDir </> subdir
-- We must create the root directory for the user package database if it
-- does not yet exists. Otherwise '${pkgroot}' will resolve to a
-- directory at the time of 'ghc-pkg register', and registration will
-- fail.
createDirectoryIfMissing True rootDir
return rootDir
pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)
-- -----------------------------------------------------------------------------
-- Utils
isDynamic :: Compiler -> Bool
isDynamic = Internal.ghcLookupProperty "GHC Dynamic"
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"