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"