module Data.Array.Accelerate.LLVM.Native.Distribution.Simple.GHC (
buildLib,
replLib,
) where
import qualified Data.Array.Accelerate.LLVM.Native.Distribution.Simple.GHC.Internal as Internal
import qualified Data.Array.Accelerate.LLVM.Native.Plugin.BuildInfo as Internal
import qualified Distribution.Simple.GHC as Cabal
import Distribution.PackageDescription as PD
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ComponentLocalBuildInfo
import qualified Distribution.Simple.Hpc as Hpc
import Distribution.Simple.BuildPaths
import Distribution.Simple.Utils
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
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.Text
import Distribution.Utils.NubList
import Language.Haskell.Extension
import Control.Monad (when, unless)
import Data.List (nub)
import Data.Maybe (catMaybes)
import System.FilePath ( (</>), replaceExtension, isRelative )
import qualified Data.Map as Map
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
let uid = componentUnitId clbi
libTargetDir = componentBuildDir lbi clbi
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 = Cabal.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
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
let isGhcDynamic = Cabal.isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
let isCoverageEnabled = libCoverage lbi
pkg_name = display (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 cObjs = map (`replaceExtension` objExtension) (cSources libBi)
baseOpts = Cabal.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 = 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,
ghcOptLinkFrameworkDirs = toNubListR $
PD.extraFrameworkDirs 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 (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
when has_code $ whenProfLib (runGhcProg profOpts)
unless (not has_code || null (cSources libBi)) $ do
info verbosity "Building C Sources..."
sequence_
[ do let baseCcOpts = Cabal.componentCcGhcOptions verbosity
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]
when has_code . ifReplLib $ do
when (null (allLibModules lib clbi)) $ warn verbosity "No exposed modules"
ifReplLib (runGhcProg replOpts)
when has_code . unless forRepl $ do
info verbosity "Linking..."
let cProfObjs = map (`replaceExtension` ("p_" ++ objExtension))
(cSources libBi)
cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
(cSources libBi)
compiler_id = compilerId (compiler lbi)
vanillaLibFilePath = libTargetDir </> mkLibName uid
profileLibFilePath = libTargetDir </> mkProfLibName uid
sharedLibFilePath = libTargetDir </> mkSharedLibName compiler_id uid
ghciLibFilePath = libTargetDir </> Internal.mkGHCiLibName uid
libInstallPath = libdir $ absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest
sharedLibInstallPath = libInstallPath </> mkSharedLibName 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 []
accObjs <- fmap (nub . concat . Map.elems)
$ Internal.readBuildInfo
$ Internal.mkBuildInfoFileName libTargetDir
unless (null accObjs && null hObjs && null cObjs && null stubObjs) $ do
rpaths <- getRPaths lbi clbi
let staticObjectFiles =
hObjs
++ accObjs
++ map (libTargetDir </>) cObjs
++ stubObjs
profObjectFiles =
hProfObjs
++ accObjs
++ map (libTargetDir </>) cProfObjs
++ stubProfObjs
ghciObjFiles =
hObjs
++ accObjs
++ map (libTargetDir </>) cObjs
++ stubObjs
dynamicObjectFiles =
hSharedObjs
++ accObjs
++ map (libTargetDir </>) cSharedObjs
++ stubSharedObjs
ghcSharedLinkArgs =
mempty {
ghcOptShared = toFlag True,
ghcOptDynLinkMode = toFlag GhcDynamicOnly,
ghcOptInputFiles = toNubListR dynamicObjectFiles,
ghcOptOutputFile = toFlag sharedLibFilePath,
ghcOptExtra = toNubListR $
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 = toNubListR $ extraLibs libBi,
ghcOptLinkLibPath = toNubListR $ extraLibDirs libBi,
ghcOptLinkFrameworks = toNubListR $ PD.frameworks libBi,
ghcOptLinkFrameworkDirs =
toNubListR $ PD.extraFrameworkDirs libBi,
ghcOptRPaths = rpaths
}
info verbosity (show (ghcOptPackages ghcSharedLinkArgs))
whenVanillaLib False $
Ar.createArLibArchive verbosity lbi vanillaLibFilePath staticObjectFiles
whenProfLib $
Ar.createArLibArchive verbosity lbi profileLibFilePath profObjectFiles
whenGHCiLib $ do
(ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
Ld.combineObjectFiles verbosity ldProg
ghciLibFilePath ghciObjFiles
whenSharedLib False $
runGhcProg ghcSharedLinkArgs
checkNeedsRecompilation :: FilePath -> GhcOptions -> IO 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
-> 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
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 Android = False
supportRPaths Ghcjs = False
supportRPaths Hurd = False
supportRPaths (OtherOS _) = False
getRPaths _ _ = return mempty
hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo
hackThreadedFlag _ _ _ = return
supportsDynamicToo :: Compiler -> Bool
supportsDynamicToo = Internal.ghcLookupProperty "Support dynamic-too"