Commit f5e713d7 authored by Luite Stegeman's avatar Luite Stegeman

Add GHCJS support to the Simple build infrastructure

parent 40ee6191
......@@ -180,6 +180,7 @@ library
Distribution.Simple.Compiler
Distribution.Simple.Configure
Distribution.Simple.GHC
Distribution.Simple.GHCJS
Distribution.Simple.Haddock
Distribution.Simple.HaskellSuite
Distribution.Simple.Hpc
......@@ -229,6 +230,7 @@ library
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.IPI641
Distribution.Simple.GHC.IPI642
Distribution.Simple.GHC.ImplInfo
Paths_Cabal
default-language: Haskell98
......
......@@ -15,6 +15,7 @@ import GHC.IO.FD (mkFD)
import GHC.IO.Device (IODeviceType(Stream))
import GHC.IO.Handle.FD (mkHandleFromFD)
import System.IO (IOMode(ReadMode, WriteMode))
#elif ghcjs_HOST_OS
#else
import System.Posix.IO (fdToHandle)
import qualified System.Posix.IO as Posix
......@@ -48,6 +49,8 @@ foreign import ccall "io.h _pipe" c__pipe ::
foreign import ccall "io.h _close" c__close ::
CInt -> IO CInt
#elif ghcjs_HOST_OS
createPipe = error "createPipe"
#else
createPipe = do
(readfd, writefd) <- Posix.createPipe
......
......@@ -25,7 +25,7 @@ import Foreign.C (getErrno, errnoToIOError)
import System.Posix.Internals (c_getpid)
#ifdef mingw32_HOST_OS
#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)
import System.Directory ( createDirectory )
#else
import qualified System.Posix
......@@ -121,7 +121,7 @@ createTempDirectory dir template = do
| otherwise -> ioError e
mkPrivateDir :: String -> IO ()
#ifdef mingw32_HOST_OS
#if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)
mkPrivateDir s = createDirectory s
#else
mkPrivateDir s = System.Posix.createDirectory s 0o700
......
......@@ -23,10 +23,11 @@ module Distribution.Simple.Build (
writeAutogenFiles,
) where
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.Build.Macros as Build.Macros
......@@ -46,7 +47,6 @@ import qualified Distribution.InstalledPackageInfo as IPI
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Program (ghcPkgProgram)
import Distribution.Simple.Setup
( Flag(..), BuildFlags(..), ReplFlags(..), fromFlag )
import Distribution.Simple.BuildTarget
......@@ -115,8 +115,7 @@ build pkg_descr lbi flags suffixes = do
-- Only bother with this message if we're building the whole package
setupMessage verbosity "Building" (packageId pkg_descr)
let Just ghcPkgProg = lookupProgram ghcPkgProgram (withPrograms lbi)
internalPackageDB <- createInternalPackageDB verbosity ghcPkgProg distPref
internalPackageDB <- createInternalPackageDB verbosity lbi distPref
withComponentsInBuildOrder pkg_descr lbi componentsToBuild $ \comp clbi ->
let bi = componentBuildInfo comp
......@@ -153,8 +152,8 @@ repl pkg_descr lbi flags suffixes args = do
initialBuildSteps distPref pkg_descr lbi verbosity
let Just ghcPkgProg = lookupProgram ghcPkgProgram (withPrograms lbi)
internalPackageDB <- createInternalPackageDB verbosity ghcPkgProg distPref
internalPackageDB <- createInternalPackageDB verbosity lbi distPref
let lbiForComponent comp lbi' =
lbi' {
withPackageDB = withPackageDB lbi ++ [internalPackageDB],
......@@ -181,8 +180,9 @@ repl pkg_descr lbi flags suffixes args = do
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> PackageDBStack -> IO ()
startInterpreter verbosity programDb comp packageDBs =
case compilerFlavor comp of
GHC -> GHC.startInterpreter verbosity programDb comp packageDBs
_ -> die "A REPL is not supported with this compiler."
GHC -> GHC.startInterpreter verbosity programDb comp packageDBs
GHCJS -> GHCJS.startInterpreter verbosity programDb comp packageDBs
_ -> die "A REPL is not supported with this compiler."
buildComponent :: Verbosity
-> Flag (Maybe Int)
......@@ -440,14 +440,22 @@ benchmarkExeV10asExe Benchmark{} _ = error "benchmarkExeV10asExe: wrong kind"
-- | Initialize a new package db file for libraries defined
-- internally to the package.
createInternalPackageDB :: Verbosity -> ConfiguredProgram -> FilePath -> IO PackageDB
createInternalPackageDB verbosity ghcPkgProg distPref = do
let dbDir = distPref </> "package.conf.inplace"
packageDB = SpecificPackageDB dbDir
exists <- doesDirectoryExist dbDir
when exists $ removeDirectoryRecursive dbDir
HcPkg.init verbosity ghcPkgProg dbDir
return packageDB
createInternalPackageDB :: Verbosity -> LocalBuildInfo -> FilePath
-> IO PackageDB
createInternalPackageDB verbosity lbi distPref = do
case compilerFlavor (compiler lbi) of
GHC -> createWith $ GHC.hcPkgInfo (withPrograms lbi)
GHCJS -> createWith $ GHCJS.hcPkgInfo (withPrograms lbi)
LHC -> createWith $ LHC.hcPkgInfo (withPrograms lbi)
_ -> return packageDB
where
dbDir = distPref </> "package.conf.inplace"
packageDB = SpecificPackageDB dbDir
createWith hpi = do
exists <- doesDirectoryExist dbDir
when exists $ removeDirectoryRecursive dbDir
HcPkg.init hpi verbosity dbDir
return packageDB
addInternalBuildTools :: PackageDescription -> LocalBuildInfo -> BuildInfo
-> ProgramDb -> ProgramDb
......@@ -472,10 +480,11 @@ buildLib :: Verbosity -> Flag (Maybe Int)
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity numJobs pkg_descr lbi lib clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi
JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi
LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi
UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi
GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi
JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi
LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi
UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
HaskellSuite {} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
_ -> die "Building is not supported with this compiler."
......@@ -484,12 +493,12 @@ buildExe :: Verbosity -> Flag (Maybe Int)
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity numJobs pkg_descr lbi exe clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi
JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi
LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi
UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
_ -> die "Building is not supported with this compiler."
GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi
GHCJS -> GHCJS.buildExe verbosity numJobs pkg_descr lbi exe clbi
JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi
LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi
UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
_ -> die "Building is not supported with this compiler."
replLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
......@@ -497,15 +506,17 @@ replLib verbosity pkg_descr lbi lib clbi =
case compilerFlavor (compiler lbi) of
-- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
-- NoFlag as the numJobs parameter.
GHC -> GHC.replLib verbosity NoFlag pkg_descr lbi lib clbi
_ -> die "A REPL is not supported for this compiler."
GHC -> GHC.replLib verbosity NoFlag pkg_descr lbi lib clbi
GHCJS -> GHCJS.replLib verbosity NoFlag pkg_descr lbi lib clbi
_ -> die "A REPL is not supported for this compiler."
replExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
replExe verbosity pkg_descr lbi exe clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.replExe verbosity NoFlag pkg_descr lbi exe clbi
_ -> die "A REPL is not supported for this compiler."
GHC -> GHC.replExe verbosity NoFlag pkg_descr lbi exe clbi
GHCJS -> GHCJS.replExe verbosity NoFlag pkg_descr lbi exe clbi
_ -> die "A REPL is not supported for this compiler."
initialBuildSteps :: FilePath -- ^"dist" prefix
......
......@@ -162,6 +162,9 @@ generate pkg_descr lbi =
supportsRelocatableProgs GHC = case buildOS of
Windows -> True
_ -> False
supportsRelocatableProgs GHCJS = case buildOS of
Windows -> True
_ -> False
supportsRelocatableProgs _ = False
paths_modulename = autogenModuleName pkg_descr
......@@ -171,9 +174,10 @@ generate pkg_descr lbi =
path_sep = show [pathSeparator]
supports_language_pragma =
compilerFlavor (compiler lbi) == GHC &&
(compilerFlavor (compiler lbi) == GHC &&
(compilerVersion (compiler lbi)
`withinRange` orLaterVersion (Version [6,6,1] []))
`withinRange` orLaterVersion (Version [6,6,1] []))) ||
compilerFlavor (compiler lbi) == GHCJS
-- | Generates the name of the environment variable controlling the path
-- component of interest.
......
......@@ -24,7 +24,9 @@ module Distribution.Simple.Compiler (
-- * Haskell implementations
module Distribution.Compiler,
Compiler(..),
showCompilerId, compilerFlavor, compilerVersion,
showCompilerId, showCompilerIdWithAbi,
compilerFlavor, compilerVersion,
compilerCompatVersion,
compilerInfo,
-- * Support for package databases
......@@ -59,7 +61,7 @@ import Control.Monad (liftM)
import Data.Binary (Binary)
import Data.List (nub)
import qualified Data.Map as M (Map, lookup)
import Data.Maybe (catMaybes, isNothing)
import Data.Maybe (catMaybes, isNothing, listToMaybe)
import GHC.Generics (Generic)
import System.Directory (canonicalizePath)
......@@ -84,12 +86,25 @@ instance Binary Compiler
showCompilerId :: Compiler -> String
showCompilerId = display . compilerId
showCompilerIdWithAbi :: Compiler -> String
showCompilerIdWithAbi comp =
display (compilerId comp) ++
case compilerAbiTag comp of
NoAbiTag -> []
AbiTag xs -> '-':xs
compilerFlavor :: Compiler -> CompilerFlavor
compilerFlavor = (\(CompilerId f _) -> f) . compilerId
compilerVersion :: Compiler -> Version
compilerVersion = (\(CompilerId _ v) -> v) . compilerId
compilerCompatVersion :: CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion flavor comp
| compilerFlavor comp == flavor = Just (compilerVersion comp)
| otherwise =
listToMaybe [ v | CompilerId fl v <- compilerCompat comp, fl == flavor ]
compilerInfo :: Compiler -> CompilerInfo
compilerInfo c = CompilerInfo (compilerId c)
(compilerAbiTag c)
......@@ -232,7 +247,10 @@ packageKeySupported = ghcSupported "Uses package keys"
ghcSupported :: String -> Compiler -> Bool
ghcSupported key comp =
case compilerFlavor comp of
GHC -> case M.lookup key (compilerProperties comp) of
Just "YES" -> True
_ -> False
_ -> False
GHC -> checkProp
GHCJS -> checkProp
_ -> False
where checkProp =
case M.lookup key (compilerProperties comp) of
Just "YES" -> True
_ -> False
......@@ -110,10 +110,11 @@ import Distribution.Version
import Distribution.Verbosity
( Verbosity, lessVerbose )
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC as JHC
import qualified Distribution.Simple.LHC as LHC
import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
-- Prefer the more generic Data.Traversable.mapM to Prelude.mapM
......@@ -574,6 +575,7 @@ configure (pkg_descr0, pbi) cfg
then return False
else case flavor of
GHC | version >= Version [6,5] [] -> return True
GHCJS -> return True
_ -> do warn verbosity
("this compiler does not support " ++
"--enable-split-objs; ignoring")
......@@ -590,7 +592,9 @@ configure (pkg_descr0, pbi) cfg
-- rely on them. By the time that bug was fixed, ghci had
-- been changed to read shared libraries instead of archive
-- files (see next code block).
not (GHC.ghcDynamic comp)
not (GHC.isDynamic comp)
CompilerId GHCJS _ ->
not (GHCJS.isDynamic comp)
_ -> False
let sharedLibsByDefault =
......@@ -598,7 +602,9 @@ configure (pkg_descr0, pbi) cfg
CompilerId GHC _ ->
-- if ghc is dynamic, then ghci needs a shared
-- library, so we build one by default.
GHC.ghcDynamic comp
GHC.isDynamic comp
CompilerId GHCJS _ ->
GHCJS.isDynamic comp
_ -> False
let lbi = LocalBuildInfo {
......@@ -785,10 +791,11 @@ getInstalledPackages verbosity comp packageDBs progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC -> GHC.getInstalledPackages verbosity packageDBs progconf
JHC -> JHC.getInstalledPackages verbosity packageDBs progconf
LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf
GHC -> GHC.getInstalledPackages verbosity packageDBs progconf
GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs progconf
JHC -> JHC.getInstalledPackages verbosity packageDBs progconf
LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf
HaskellSuite {} ->
HaskellSuite.getInstalledPackages verbosity packageDBs progconf
flv -> die $ "don't know how to find the installed packages for "
......@@ -802,7 +809,7 @@ getPackageDBContents verbosity comp packageDB progconf = do
info verbosity "Reading installed packages..."
case compilerFlavor comp of
GHC -> GHC.getPackageDBContents verbosity packageDB progconf
GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progconf
-- For other compilers, try to fall back on 'getInstalledPackages'.
_ -> getInstalledPackages verbosity comp [packageDB] progconf
......@@ -1105,11 +1112,12 @@ configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
configCompilerEx Nothing _ _ _ _ = die "Unknown compiler"
configCompilerEx (Just hcFlavor) hcPath hcPkg conf verbosity = do
(comp, maybePlatform, programsConfig) <- case hcFlavor of
GHC -> GHC.configure verbosity hcPath hcPkg conf
JHC -> JHC.configure verbosity hcPath hcPkg conf
LHC -> do (_, _, ghcConf) <- GHC.configure verbosity Nothing hcPkg conf
LHC.configure verbosity hcPath Nothing ghcConf
UHC -> UHC.configure verbosity hcPath hcPkg conf
GHC -> GHC.configure verbosity hcPath hcPkg conf
GHCJS -> GHCJS.configure verbosity hcPath hcPkg conf
JHC -> JHC.configure verbosity hcPath hcPkg conf
LHC -> do (_, _, ghcConf) <- GHC.configure verbosity Nothing hcPkg conf
LHC.configure verbosity hcPath Nothing ghcConf
UHC -> UHC.configure verbosity hcPath hcPkg conf
HaskellSuite {} -> HaskellSuite.configure verbosity hcPath hcPkg conf
_ -> die "Unknown compiler"
return (comp, fromMaybe buildPlatform maybePlatform, programsConfig)
......
......@@ -38,23 +38,22 @@ module Distribution.Simple.GHC (
startInterpreter,
installLib, installExe,
libAbiHash,
initPackageDB,
invokeHcPkg,
hcPkgInfo,
registerPackage,
componentGhcOptions,
ghcLibDir,
ghcDynamic,
ghcGlobalPackageDB,
getLibDir,
isDynamic,
getGlobalPackageDB,
) 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(..), libModules, exeModules
, hcOptions, hcProfOptions, hcSharedOptions
, usedExtensions, allExtensions, ModuleRenaming, lookupRenaming )
( PackageDescription(..), BuildInfo(..), Executable(..), Library(..)
, allExtensions, libModules, exeModules
, hcOptions, hcSharedOptions, hcProfOptions )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
......@@ -63,25 +62,21 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
, LibraryName(..), absoluteInstallDirs )
, absoluteInstallDirs )
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(..), InstalledPackageId, PackageId )
( PackageName(..) )
import qualified Distribution.ModuleName as ModuleName
import Distribution.Simple.Program
( Program(..), ConfiguredProgram(..), ProgramConfiguration
, ProgramLocation(..), ProgramSearchPath, ProgramSearchPathEntry(..)
, rawSystemProgram
, ProgramSearchPath
, rawSystemProgramStdout, rawSystemProgramStdoutConf
, getProgramOutput, getProgramInvocationOutput, suppressOverrideArgs
, requireProgramVersion, requireProgram
, getProgramInvocationOutput, requireProgramVersion, requireProgram
, userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
, ghcProgram, ghcPkgProgram, hsc2hsProgram
, arProgram, ldProgram
, gccProgram, stripProgram )
, 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
......@@ -93,34 +88,31 @@ import qualified Distribution.Simple.Setup as Cabal
( Flag )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, OptimisationLevel(..), PackageDB(..), PackageDBStack, AbiTag(..)
, Flag )
, PackageDB(..), PackageDBStack, AbiTag(..) )
import Distribution.Version
( Version(..), anyVersion, orLaterVersion )
import Distribution.System
( Platform(..), OS(..), buildOS, platformFromTriple )
( Platform(..), OS(..) )
import Distribution.Verbosity
import Distribution.Text
( display, simpleParse )
( display )
import Distribution.Utils.NubList
( overNubListR, toNubListR )
import Language.Haskell.Extension (Language(..), Extension(..)
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 ( Map, fromList, lookup )
import Data.Maybe ( catMaybes, fromMaybe, maybeToList )
import qualified Data.Map as M ( fromList )
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid(..) )
import System.Directory
( getDirectoryContents, doesFileExist, getTemporaryDirectory )
import System.Directory ( doesFileExist )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension )
import System.IO (hClose, hPutStrLn)
import System.Environment (getEnv)
import Distribution.Compat.Exception (catchExit, catchIO)
import Distribution.Compat.Exception (catchIO)
-- -----------------------------------------------------------------------------
-- Configuring
......@@ -134,6 +126,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
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
......@@ -155,10 +148,10 @@ configure verbosity hcPath hcPkgPath conf0 = do
}
conf3 = addKnownProgram hsc2hsProgram' conf2
languages <- Internal.getLanguages verbosity ghcProg
extensions <- Internal.getExtensions verbosity ghcProg
languages <- Internal.getLanguages verbosity implInfo ghcProg
extensions <- Internal.getExtensions verbosity implInfo ghcProg
ghcInfo <- Internal.getGhcInfo verbosity ghcProg
ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg
let ghcInfoMap = M.fromList ghcInfo
let comp = Compiler {
......@@ -170,7 +163,7 @@ configure verbosity hcPath hcPkgPath conf0 = do
compilerProperties = ghcInfoMap
}
compPlatform = Internal.targetPlatform ghcInfo
conf4 = Internal.configureToolchain ghcProg ghcInfoMap conf3 -- configure gcc and ld
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
......@@ -245,7 +238,10 @@ guessHsc2hsFromGhcPath :: ConfiguredProgram
guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
getGhcInfo = Internal.getGhcInfo
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
......@@ -283,7 +279,7 @@ 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 <- ghcLibDir' verbosity ghcProg
topDir <- getLibDir' verbosity ghcProg
let indices = [ PackageIndex.fromList (map (Internal.substTopDir topDir) pkgs)
| (_, pkgs) <- pkgss ]
return $! (mconcat indices)
......@@ -291,21 +287,21 @@ toPackageIndex verbosity pkgss conf = do
where
Just ghcProg = lookupProgram ghcProgram conf
ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
ghcLibDir verbosity lbi =
getLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
getLibDir verbosity lbi =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdoutConf verbosity ghcProgram
(withPrograms lbi) ["--print-libdir"]
ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
ghcLibDir' verbosity ghcProg =
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.
ghcGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
ghcGlobalPackageDB verbosity ghcProg =
getGlobalPackageDB :: Verbosity -> ConfiguredProgram -> IO FilePath
getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"]
......@@ -350,12 +346,11 @@ getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
getInstalledPackages' verbosity packagedbs conf
| ghcVersion >= Version [6,9] [] =
sequence
[ do pkgs <- HcPkg.dump verbosity ghcPkgProg packagedb
[ do pkgs <- HcPkg.dump (hcPkgInfo conf) verbosity packagedb
return (packagedb, pkgs)
| packagedb <- packagedbs ]
where
Just ghcPkgProg = lookupProgram ghcPkgProgram conf
Just ghcProg = lookupProgram ghcProgram conf
Just ghcVersion = programVersion ghcProg
......@@ -420,6 +415,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
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)
......@@ -429,8 +425,8 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
let isGhcDynamic = ghcDynamic comp
dynamicTooSupported = ghcSupportsDynamicToo comp
let isGhcDynamic = isDynamic comp
dynamicTooSupported = supportsDynamicToo comp
doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
forceVanillaLib = doingTH && not isGhcDynamic
forceSharedLib = doingTH && isGhcDynamic
......@@ -450,7 +446,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
-- TODO: do we need to put hs-boot files into place for mutually recursive
-- modules?
let cObjs = map (`replaceExtension` objExtension) (cSources libBi)
baseOpts = Internal.componentGhcOptions verbosity lbi libBi clbi libTargetDir
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
`mappend` mempty { ghcOptHPCDir = hpcdir }
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
......@@ -517,8 +513,8 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
unless (null (cSources libBi)) $ do
info verbosity "Building C Sources..."
sequence_
[ do let baseCcOpts = Internal.componentCcGhcOptions verbosity lbi
libBi clbi libTargetDir filename
[ 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.
......@@ -578,16 +574,16 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
| ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
, x <- libModules lib ]
hObjs <- Internal.getHaskellObjects lib lbi
hObjs <- Internal.getHaskellObjects implInfo lib lbi
libTargetDir objExtension True
hProfObjs <-
if (withProfLib lbi)
then Internal.getHaskellObjects lib lbi
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("p_" ++ objExtension) True
else return []
hSharedObjs <-
if (withSharedLib lbi)
then Internal.getHaskellObjects lib lbi
then Internal.getHaskellObjects implInfo lib lbi
libTargetDir ("dyn_" ++ objExtension) False
else return []
......@@ -676,6 +672,7 @@ buildOrReplExe forRepl verbosity numJobs _pkg_descr lbi
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let comp = compiler lbi
implInfo = getImplInfo comp
runGhcProg = runGHC verbosity ghcProg comp
exeBi <