{-# 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"