Distribution/Simple/LHC.hs

    {-# LANGUAGE CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.LHC
    -- 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.LHC (
            configure, getInstalledPackages,
            buildLib, buildExe,
            installLib, installExe,
            registerPackage,
            hcPkgInfo,
            ghcOptions,
            ghcVerbosityOptions
     ) where

    import Distribution.PackageDescription as PD
             ( PackageDescription(..), BuildInfo(..), Executable(..)
             , Library(..), libModules, hcOptions, hcProfOptions, hcSharedOptions
             , usedExtensions, allExtensions )
    import Distribution.InstalledPackageInfo
                                    ( InstalledPackageInfo
                                    , parseInstalledPackageInfo )
    import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
                                    ( InstalledPackageInfo_(..) )
    import Distribution.Simple.PackageIndex
    import qualified Distribution.Simple.PackageIndex as PackageIndex
    import Distribution.ParseUtils  ( ParseResult(..) )
    import Distribution.Simple.LocalBuildInfo
             ( LocalBuildInfo(..), ComponentLocalBuildInfo(..),
               LibraryName(..) )
    import Distribution.Simple.InstallDirs
    import Distribution.Simple.BuildPaths
    import Distribution.Simple.Utils
    import Distribution.Package
             ( Package(..) )
    import qualified Distribution.ModuleName as ModuleName
    import Distribution.Simple.Program
             ( Program(..), ConfiguredProgram(..), ProgramConfiguration
             , ProgramSearchPath, ProgramLocation(..)
             , rawSystemProgram, rawSystemProgramConf
             , rawSystemProgramStdout, rawSystemProgramStdoutConf
             , requireProgramVersion
             , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
             , arProgram, ldProgram
             , gccProgram, stripProgram
             , lhcProgram, lhcPkgProgram )
    import qualified Distribution.Simple.Program.HcPkg as HcPkg
    import Distribution.Simple.Compiler
             ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
             , OptimisationLevel(..), PackageDB(..), PackageDBStack, AbiTag(..)
             , Flag, languageToFlags, extensionsToFlags )
    import Distribution.Version
             ( Version(..), orLaterVersion )
    import Distribution.System
             ( OS(..), buildOS )
    import Distribution.Verbosity
    import Distribution.Text
             ( display, simpleParse )
    import Language.Haskell.Extension
             ( Language(Haskell98), Extension(..), KnownExtension(..) )

    import Control.Monad            ( unless, when )
    import Data.List
    import qualified Data.Map as M  ( empty )
    import Data.Maybe               ( catMaybes )
    #if __GLASGOW_HASKELL__ < 710
    import Data.Monoid              ( Monoid(..) )
    #endif
    import System.Directory         ( removeFile, renameFile,
                                      getDirectoryContents, doesFileExist,
                                      getTemporaryDirectory )
    import System.FilePath          ( (</>), (<.>), takeExtension,
                                      takeDirectory, replaceExtension )
    import System.IO (hClose, hPutStrLn)
    import Distribution.Compat.Exception (catchExit, catchIO)
    import Distribution.System ( Platform )

    -- -----------------------------------------------------------------------------
    -- Configuring

    configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
              -> ProgramConfiguration -> IO (Compiler, Maybe Platform, ProgramConfiguration)
    configure verbosity hcPath hcPkgPath conf = do

      (lhcProg, lhcVersion, conf') <-
        requireProgramVersion verbosity lhcProgram
          (orLaterVersion (Version [0,7] []))
          (userMaybeSpecifyPath "lhc" hcPath conf)

      (lhcPkgProg, lhcPkgVersion, conf'') <-
        requireProgramVersion verbosity lhcPkgProgram
          (orLaterVersion (Version [0,7] []))
          (userMaybeSpecifyPath "lhc-pkg" hcPkgPath conf')

      when (lhcVersion /= lhcPkgVersion) $ die $
           "Version mismatch between lhc and lhc-pkg: "
        ++ programPath lhcProg ++ " is version " ++ display lhcVersion ++ " "
        ++ programPath lhcPkgProg ++ " is version " ++ display lhcPkgVersion

      languages  <- getLanguages  verbosity lhcProg
      extensions <- getExtensions verbosity lhcProg

      let comp = Compiler {
            compilerId             = CompilerId LHC lhcVersion,
            compilerAbiTag         = NoAbiTag,
            compilerCompat         = [],
            compilerLanguages      = languages,
            compilerExtensions     = extensions,
            compilerProperties     = M.empty
          }
          conf''' = configureToolchain lhcProg conf'' -- configure gcc and ld
          compPlatform = Nothing
      return (comp, compPlatform, conf''')

    -- | Adjust the way we find and configure gcc and ld
    --
    configureToolchain :: ConfiguredProgram -> ProgramConfiguration
                                            -> ProgramConfiguration
    configureToolchain lhcProg =
        addKnownProgram gccProgram {
          programFindLocation = findProg gccProgram (baseDir </> "gcc.exe"),
          programPostConf     = configureGcc
        }
      . addKnownProgram ldProgram {
          programFindLocation = findProg ldProgram (libDir </> "ld.exe"),
          programPostConf     = configureLd
        }
      where
        compilerDir = takeDirectory (programPath lhcProg)
        baseDir     = takeDirectory compilerDir
        libDir      = baseDir </> "gcc-lib"
        includeDir  = baseDir </> "include" </> "mingw"
        isWindows   = case buildOS of Windows -> True; _ -> False

        -- on Windows finding and configuring ghc's gcc and ld is a bit special
        findProg :: Program -> FilePath
                 -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
        findProg prog location | isWindows = \verbosity searchpath -> do
            exists <- doesFileExist location
            if exists then return (Just location)
                      else do warn verbosity ("Couldn't find " ++ programName prog ++ " where I expected it. Trying the search path.")
                              programFindLocation prog verbosity searchpath
          | otherwise = programFindLocation prog

        configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
        configureGcc
          | isWindows = \_ gccProg -> case programLocation gccProg of
              -- if it's found on system then it means we're using the result
              -- of programFindLocation above rather than a user-supplied path
              -- that means we should add this extra flag to tell ghc's gcc
              -- where it lives and thus where gcc can find its various files:
              FoundOnSystem {} -> return gccProg {
                                    programDefaultArgs = ["-B" ++ libDir,
                                                          "-I" ++ includeDir]
                                  }
              UserSpecified {} -> return gccProg
          | otherwise = \_ gccProg -> return gccProg

        -- we need to find out if ld supports the -x flag
        configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
        configureLd verbosity ldProg = do
          tempDir <- getTemporaryDirectory
          ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->
                 withTempFile tempDir ".o" $ \testofile testohnd -> do
                   hPutStrLn testchnd "int foo() { return 0; }"
                   hClose testchnd; hClose testohnd
                   rawSystemProgram verbosity lhcProg ["-c", testcfile,
                                                       "-o", testofile]
                   withTempFile tempDir ".o" $ \testofile' testohnd' ->
                     do
                       hClose testohnd'
                       _ <- rawSystemProgramStdout verbosity ldProg
                         ["-x", "-r", testofile, "-o", testofile']
                       return True
                     `catchIO`   (\_ -> return False)
                     `catchExit` (\_ -> return False)
          if ldx
            then return ldProg { programDefaultArgs = ["-x"] }
            else return ldProg

    getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]
    getLanguages _ _ = return [(Haskell98, "")]
    --FIXME: does lhc support -XHaskell98 flag? from what version?

    getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
    getExtensions verbosity lhcProg = do
        exts <- rawSystemStdout verbosity (programPath lhcProg)
                  ["--supported-languages"]
        -- GHC has the annoying habit of inverting some of the extensions
        -- so we have to try parsing ("No" ++ ghcExtensionName) first
        let readExtension str = do
              ext <- simpleParse ("No" ++ str)
              case ext of
                UnknownExtension _ -> simpleParse str
                _                  -> return ext
        return $ [ (ext, "-X" ++ display ext)
                 | Just ext <- map readExtension (lines exts) ]

    getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
                         -> IO InstalledPackageIndex
    getInstalledPackages verbosity packagedbs conf = do
      checkPackageDbStack packagedbs
      pkgss <- getInstalledPackages' lhcPkg verbosity packagedbs conf
      let indexes = [ PackageIndex.fromList (map (substTopDir topDir) pkgs)
                    | (_, pkgs) <- pkgss ]
      return $! (mconcat indexes)

      where
        -- 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
        Just ghcProg = lookupProgram lhcProgram conf
        Just lhcPkg  = lookupProgram lhcPkgProgram conf
        compilerDir  = takeDirectory (programPath ghcProg)
        topDir       = takeDirectory compilerDir

    checkPackageDbStack :: PackageDBStack -> IO ()
    checkPackageDbStack (GlobalPackageDB:rest)
      | GlobalPackageDB `notElem` rest = return ()
    checkPackageDbStack _ =
      die $ "GHC.getInstalledPackages: the global package db must be "
         ++ "specified first and cannot be specified multiple times"

    -- | Get the packages from specific PackageDBs, not cumulative.
    --
    getInstalledPackages' :: ConfiguredProgram -> Verbosity
                          -> [PackageDB] -> ProgramConfiguration
                          -> IO [(PackageDB, [InstalledPackageInfo])]
    getInstalledPackages' lhcPkg verbosity packagedbs conf
      =
      sequence
        [ do str <- rawSystemProgramStdoutConf verbosity lhcPkgProgram conf
                      ["dump", packageDbGhcPkgFlag packagedb]
               `catchExit` \_ -> die $ "ghc-pkg dump failed"
             case parsePackages str of
               Left ok -> return (packagedb, ok)
               _       -> die "failed to parse output of 'ghc-pkg dump'"
        | packagedb <- packagedbs ]

      where
        parsePackages str =
          let parsed = map parseInstalledPackageInfo (splitPkgs str)
           in case [ msg | ParseFailed msg <- parsed ] of
                []   -> Left [ pkg | ParseOk _ pkg <- parsed ]
                msgs -> Right msgs

        splitPkgs :: String -> [String]
        splitPkgs = map unlines . splitWith ("---" ==) . lines
          where
            splitWith :: (a -> Bool) -> [a] -> [[a]]
            splitWith p xs = ys : case zs of
                               []   -> []
                               _:ws -> splitWith p ws
              where (ys,zs) = break p xs

        packageDbGhcPkgFlag GlobalPackageDB          = "--global"
        packageDbGhcPkgFlag UserPackageDB            = "--user"
        packageDbGhcPkgFlag (SpecificPackageDB path) = "--" ++ packageDbFlag ++ "=" ++ path

        packageDbFlag
          | programVersion lhcPkg < Just (Version [7,5] [])
          = "package-conf"
          | otherwise
          = "package-db"

    substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
    substTopDir topDir ipo
     = ipo {
           InstalledPackageInfo.importDirs
               = map f (InstalledPackageInfo.importDirs ipo),
           InstalledPackageInfo.libraryDirs
               = map f (InstalledPackageInfo.libraryDirs ipo),
           InstalledPackageInfo.includeDirs
               = map f (InstalledPackageInfo.includeDirs ipo),
           InstalledPackageInfo.frameworkDirs
               = map f (InstalledPackageInfo.frameworkDirs ipo),
           InstalledPackageInfo.haddockInterfaces
               = map f (InstalledPackageInfo.haddockInterfaces ipo),
           InstalledPackageInfo.haddockHTMLs
               = map f (InstalledPackageInfo.haddockHTMLs ipo)
       }
        where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
              f x = x

    -- -----------------------------------------------------------------------------
    -- Building

    -- | Build a library with LHC.
    --
    buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
                          -> Library            -> ComponentLocalBuildInfo -> IO ()
    buildLib verbosity 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 pref = buildDir lbi
          pkgid = packageId pkg_descr
          runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)
          ifVanillaLib forceVanilla = when (forceVanilla || withVanillaLib lbi)
          ifProfLib = when (withProfLib lbi)
          ifSharedLib = when (withSharedLib lbi)
          ifGHCiLib = when (withGHCiLib lbi && withVanillaLib lbi)

      libBi <- hackThreadedFlag verbosity
                 (compiler lbi) (withProfLib lbi) (libBuildInfo lib)

      let libTargetDir = pref
          forceVanillaLib = EnableExtension TemplateHaskell `elem` allExtensions libBi
          -- TH always needs vanilla libs, even when building for profiling

      createDirectoryIfMissingVerbose verbosity True libTargetDir
      -- TODO: do we need to put hs-boot files into place for mutually recursive modules?
      let ghcArgs =
                 ["-package-name", display pkgid ]
              ++ constructGHCCmdLine lbi libBi clbi libTargetDir verbosity
              ++ map display (libModules lib)
          lhcWrap x = ["--build-library", "--ghc-opts=" ++ unwords x]
          ghcArgsProf = ghcArgs
              ++ ["-prof",
                  "-hisuf", "p_hi",
                  "-osuf", "p_o"
                 ]
              ++ hcProfOptions GHC libBi
          ghcArgsShared = ghcArgs
              ++ ["-dynamic",
                  "-hisuf", "dyn_hi",
                  "-osuf", "dyn_o", "-fPIC"
                 ]
              ++ hcSharedOptions GHC libBi
      unless (null (libModules lib)) $
        do ifVanillaLib forceVanillaLib (runGhcProg $ lhcWrap ghcArgs)
           ifProfLib (runGhcProg $ lhcWrap ghcArgsProf)
           ifSharedLib (runGhcProg $ lhcWrap ghcArgsShared)

      -- build any C sources
      unless (null (cSources libBi)) $ do
         info verbosity "Building C Sources..."
         sequence_ [do let (odir,args) = constructCcCmdLine lbi libBi clbi pref
                                                            filename verbosity
                       createDirectoryIfMissingVerbose verbosity True odir
                       runGhcProg args
                       ifSharedLib (runGhcProg (args ++ ["-fPIC", "-osuf dyn_o"]))
                   | filename <- cSources libBi]

      -- link:
      info verbosity "Linking..."
      let cObjs = map (`replaceExtension` 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 </> mkGHCiLibName       libName

      stubObjs <- fmap catMaybes $ sequence
        [ findFileWithExtension [objExtension] [libTargetDir]
            (ModuleName.toFilePath x ++"_stub")
        | x <- libModules lib ]
      stubProfObjs <- fmap catMaybes $ sequence
        [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
            (ModuleName.toFilePath x ++"_stub")
        | x <- libModules lib ]
      stubSharedObjs <- fmap catMaybes $ sequence
        [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
            (ModuleName.toFilePath x ++"_stub")
        | x <- libModules lib ]

      hObjs     <- getHaskellObjects lib lbi
                        pref objExtension True
      hProfObjs <-
        if (withProfLib lbi)
                then getHaskellObjects lib lbi
                        pref ("p_" ++ objExtension) True
                else return []
      hSharedObjs <-
        if (withSharedLib lbi)
                then getHaskellObjects lib lbi
                        pref ("dyn_" ++ objExtension) False
                else return []

      unless (null hObjs && null cObjs && null stubObjs) $ do
        -- first remove library files if they exists
        sequence_
          [ removeFile libFilePath `catchIO` \_ -> return ()
          | libFilePath <- [vanillaLibFilePath, profileLibFilePath
                           ,sharedLibFilePath,  ghciLibFilePath] ]

        let arVerbosity | verbosity >= deafening = "v"
                        | verbosity >= normal = ""
                        | otherwise = "c"
            arArgs = ["q"++ arVerbosity]
                ++ [vanillaLibFilePath]
            arObjArgs =
                   hObjs
                ++ map (pref </>) cObjs
                ++ stubObjs
            arProfArgs = ["q"++ arVerbosity]
                ++ [profileLibFilePath]
            arProfObjArgs =
                   hProfObjs
                ++ map (pref </>) cObjs
                ++ stubProfObjs
            ldArgs = ["-r"]
                ++ ["-o", ghciLibFilePath <.> "tmp"]
            ldObjArgs =
                   hObjs
                ++ map (pref </>) cObjs
                ++ stubObjs
            ghcSharedObjArgs =
                   hSharedObjs
                ++ map (pref </>) 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 =
                [ "-no-auto-link-packages",
                  "-shared",
                  "-dynamic",
                  "-o", sharedLibFilePath ]
                ++ ghcSharedObjArgs
                ++ ["-package-name", display pkgid ]
                ++ ghcPackageFlags lbi clbi
                ++ ["-l"++extraLib | extraLib <- extraLibs libBi]
                ++ ["-L"++extraLibDir | extraLibDir <- extraLibDirs libBi]

            runLd ldLibName args = do
              exists <- doesFileExist ldLibName
                -- This method is called iteratively by xargs. The
                -- output goes to <ldLibName>.tmp, and any existing file
                -- named <ldLibName> is included when linking. The
                -- output is renamed to <libName>.
              rawSystemProgramConf verbosity ldProgram (withPrograms lbi)
                (args ++ if exists then [ldLibName] else [])
              renameFile (ldLibName <.> "tmp") ldLibName

            runAr = rawSystemProgramConf verbosity arProgram (withPrograms lbi)

             --TODO: discover this at configure time or runtime on Unix
             -- The value is 32k on Windows and POSIX specifies a minimum of 4k
             -- but all sensible Unixes use more than 4k.
             -- we could use getSysVar ArgumentLimit but that's in the Unix lib
            maxCommandLineSize = 30 * 1024

        ifVanillaLib False $ xargs maxCommandLineSize
          runAr arArgs arObjArgs

        ifProfLib $ xargs maxCommandLineSize
          runAr arProfArgs arProfObjArgs

        ifGHCiLib $ xargs maxCommandLineSize
          (runLd ghciLibFilePath) ldArgs ldObjArgs

        ifSharedLib $ runGhcProg ghcSharedLinkArgs

    -- | Build an executable with LHC.
    --
    buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
                          -> Executable         -> ComponentLocalBuildInfo -> IO ()
    buildExe verbosity _pkg_descr lbi
      exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
      let pref = buildDir lbi
          runGhcProg = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)

      exeBi <- hackThreadedFlag verbosity
                 (compiler lbi) (withProfExe lbi) (buildInfo exe)

      -- exeNameReal, the name that GHC really uses (with .exe on Windows)
      let exeNameReal = exeName' <.>
                        (if null $ takeExtension exeName' then exeExtension else "")

      let targetDir = pref </> 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?

      -- build executables
      unless (null (cSources exeBi)) $ do
       info verbosity "Building C Sources."
       sequence_ [do let (odir,args) = constructCcCmdLine lbi exeBi clbi
                                              exeDir filename verbosity
                     createDirectoryIfMissingVerbose verbosity True odir
                     runGhcProg args
                 | filename <- cSources exeBi]

      srcMainFile <- findFile (exeDir : hsSourceDirs exeBi) modPath

      let cObjs = map (`replaceExtension` objExtension) (cSources exeBi)
      let lhcWrap x = ("--ghc-opts\"":x) ++ ["\""]
      let binArgs linkExe profExe =
                 (if linkExe
                     then ["-o", targetDir </> exeNameReal]
                     else ["-c"])
              ++ constructGHCCmdLine lbi exeBi clbi exeDir verbosity
              ++ [exeDir </> x | x <- cObjs]
              ++ [srcMainFile]
              ++ ["-optl" ++ opt | opt <- PD.ldOptions exeBi]
              ++ ["-l"++lib | lib <- extraLibs exeBi]
              ++ ["-L"++libDir | libDir <- extraLibDirs exeBi]
              ++ concat [["-framework", f] | f <- PD.frameworks exeBi]
              ++ if profExe
                    then ["-prof",
                          "-hisuf", "p_hi",
                          "-osuf", "p_o"
                         ] ++ hcProfOptions GHC exeBi
                    else []

      -- For building exe's for profiling that use TH we actually
      -- have to build twice, once without profiling and the again
      -- with profiling. 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.
      when (withProfExe lbi && EnableExtension TemplateHaskell `elem` allExtensions exeBi)
         (runGhcProg $ lhcWrap (binArgs False False))

      runGhcProg (binArgs True (withProfExe lbi))

    -- | 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 ]

    -- when using -split-objs, we need to search for object files in the
    -- Module_split directory for each module.
    getHaskellObjects :: Library -> LocalBuildInfo
                      -> FilePath -> String -> Bool -> IO [FilePath]
    getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
      | splitObjs lbi && allow_split_objs = do
            let dirs = [ pref </> (ModuleName.toFilePath x ++ "_split")
                       | x <- libModules lib ]
            objss <- mapM getDirectoryContents dirs
            let objs = [ dir </> obj
                       | (objs',dir) <- zip objss dirs, obj <- objs',
                         let obj_ext = takeExtension obj,
                         '.':wanted_obj_ext == obj_ext ]
            return objs
      | otherwise  =
            return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
                   | x <- libModules lib ]

    constructGHCCmdLine
            :: LocalBuildInfo
            -> BuildInfo
            -> ComponentLocalBuildInfo
            -> FilePath
            -> Verbosity
            -> [String]
    constructGHCCmdLine lbi bi clbi odir verbosity =
            ["--make"]
         ++ ghcVerbosityOptions verbosity
            -- Unsupported extensions have already been checked by configure
         ++ ghcOptions lbi bi clbi odir

    ghcVerbosityOptions :: Verbosity -> [String]
    ghcVerbosityOptions verbosity
         | verbosity >= deafening = ["-v"]
         | verbosity >= normal    = []
         | otherwise              = ["-w", "-v0"]

    ghcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
               -> FilePath -> [String]
    ghcOptions lbi bi clbi odir
         =  ["-hide-all-packages"]
         ++ ghcPackageDbOptions lbi
         ++ (if splitObjs lbi then ["-split-objs"] else [])
         ++ ["-i"]
         ++ ["-i" ++ odir]
         ++ ["-i" ++ l | l <- nub (hsSourceDirs bi)]
         ++ ["-i" ++ autogenModulesDir lbi]
         ++ ["-I" ++ autogenModulesDir lbi]
         ++ ["-I" ++ odir]
         ++ ["-I" ++ dir | dir <- PD.includeDirs bi]
         ++ ["-optP" ++ opt | opt <- cppOptions bi]
         ++ [ "-optP-include", "-optP"++ (autogenModulesDir lbi </> cppHeaderName) ]
         ++ [ "-#include \"" ++ inc ++ "\"" | inc <- PD.includes bi ]
         ++ [ "-odir",  odir, "-hidir", odir ]
         ++ (if compilerVersion c >= Version [6,8] []
               then ["-stubdir", odir] else [])
         ++ ghcPackageFlags lbi clbi
         ++ (case withOptimization lbi of
               NoOptimisation      -> []
               NormalOptimisation  -> ["-O"]
               MaximumOptimisation -> ["-O2"])
         ++ hcOptions GHC bi
         ++ languageToFlags c (defaultLanguage bi)
         ++ extensionsToFlags c (usedExtensions bi)
        where c = compiler lbi

    ghcPackageFlags :: LocalBuildInfo -> ComponentLocalBuildInfo -> [String]
    ghcPackageFlags lbi clbi
      | ghcVer >= Version [6,11] []
                  = concat [ ["-package-id", display ipkgid]
                           | (ipkgid, _) <- componentPackageDeps clbi ]

      | otherwise = concat [ ["-package", display pkgid]
                           | (_, pkgid)  <- componentPackageDeps clbi ]
        where
          ghcVer = compilerVersion (compiler lbi)

    ghcPackageDbOptions :: LocalBuildInfo -> [String]
    ghcPackageDbOptions lbi = case dbstack of
      (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
      (GlobalPackageDB:dbs)               -> ("-no-user-" ++ packageDbFlag)
                                           : concatMap specific dbs
      _                                   -> ierror
     where
        specific (SpecificPackageDB db) = [ '-':packageDbFlag, db ]
        specific _ = ierror
        ierror     = error ("internal error: unexpected package db stack: " ++ show dbstack)

        dbstack = withPackageDB lbi
        packageDbFlag
          | compilerVersion (compiler lbi) < Version [7,5] []
          = "package-conf"
          | otherwise
          = "package-db"

    constructCcCmdLine :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
                       -> FilePath -> FilePath -> Verbosity -> (FilePath,[String])
    constructCcCmdLine lbi bi clbi pref filename verbosity
      =  let odir | compilerVersion (compiler lbi) >= Version [6,4,1] []  = pref
                  | otherwise = pref </> takeDirectory filename
                            -- ghc 6.4.1 fixed a bug in -odir handling
                            -- for C compilations.
         in
            (odir,
             ghcCcOptions lbi bi clbi odir
             ++ (if verbosity >= deafening then ["-v"] else [])
             ++ ["-c",filename])

    ghcCcOptions :: LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo
                 -> FilePath -> [String]
    ghcCcOptions lbi bi clbi odir
         =  ["-I" ++ dir | dir <- PD.includeDirs bi]
         ++ ghcPackageDbOptions lbi
         ++ ghcPackageFlags lbi clbi
         ++ ["-optc" ++ opt | opt <- PD.ccOptions bi]
         ++ (case withOptimization lbi of
               NoOptimisation -> []
               _              -> ["-optc-O2"])
         ++ ["-odir", odir]

    mkGHCiLibName :: LibraryName -> String
    mkGHCiLibName (LibraryName lib) = lib <.> "o"

    -- -----------------------------------------------------------------------------
    -- 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)
              stripExe verbosity lbi exeFileName (dest <.> exeExtension)
      installBinary (binDir </> fixedExeBaseName)

    stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
    stripExe verbosity lbi name path = when (stripExes lbi) $
      case lookupProgram stripProgram (withPrograms lbi) of
        Just strip -> rawSystemProgram verbosity strip args
        Nothing    -> unless (buildOS == Windows) $
                      -- Don't bother warning on windows, we don't expect them to
                      -- have the strip program anyway.
                      warn verbosity $ "Unable to strip executable '" ++ name
                                    ++ "' (missing the 'strip' program)"
      where
        args = path : case buildOS of
           OSX -> ["-x"] -- By default, stripping the ghc binary on at least
                         -- some OS X installations causes:
                         --     HSbase-3.0.o: unknown symbol `_environ'"
                         -- The -x flag fixes that.
           _   -> []

    -- |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:
      let copy src dst n = do
            createDirectoryIfMissingVerbose verbosity True dst
            installOrdinaryFile verbosity (src </> n) (dst </> n)
          copyModuleFiles ext =
            findModuleFiles [builtDir] [ext] (libModules lib)
              >>= installOrdinaryFiles verbosity targetDir
      ifVanilla $ copyModuleFiles "hi"
      ifProf    $ copyModuleFiles "p_hi"
      hcrFiles <- findModuleFiles (builtDir : hsSourceDirs (libBuildInfo lib)) ["hcr"] (libModules lib)
      flip mapM_ hcrFiles $ \(srcBase, srcFile) -> runLhc ["--install-library", srcBase </> srcFile]

      -- copy the built library files over:
      ifVanilla $ mapM_ (copy builtDir targetDir)       vanillaLibNames
      ifProf    $ mapM_ (copy builtDir targetDir)       profileLibNames
      ifGHCi    $ mapM_ (copy builtDir targetDir)       ghciLibNames
      ifShared  $ mapM_ (copy builtDir dynlibTargetDir) sharedLibNames

      where
        cid = compilerId (compiler lbi)
        libNames = componentLibraries clbi
        vanillaLibNames = map mkLibName             libNames
        profileLibNames = map mkProfLibName         libNames
        ghciLibNames    = map mkGHCiLibName         libNames
        sharedLibNames  = map (mkSharedLibName cid) libNames

        hasLib    = not $ null (libModules lib)
                       && null (cSources (libBuildInfo lib))
        ifVanilla = when (hasLib && withVanillaLib lbi)
        ifProf    = when (hasLib && withProfLib    lbi)
        ifGHCi    = when (hasLib && withGHCiLib    lbi)
        ifShared  = when (hasLib && withSharedLib  lbi)

        runLhc    = rawSystemProgramConf verbosity lhcProgram (withPrograms lbi)

    -- -----------------------------------------------------------------------------
    -- Registering

    registerPackage
      :: Verbosity
      -> InstalledPackageInfo
      -> PackageDescription
      -> LocalBuildInfo
      -> Bool
      -> PackageDBStack
      -> IO ()
    registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs =
      HcPkg.reregister (hcPkgInfo $ withPrograms lbi) verbosity packageDbs
        (Right installedPkgInfo)

    hcPkgInfo :: ProgramConfiguration -> HcPkg.HcPkgInfo
    hcPkgInfo conf = HcPkg.HcPkgInfo { HcPkg.hcPkgProgram    = lhcPkgProg
                                     , HcPkg.noPkgDbStack    = False
                                     , HcPkg.noVerboseFlag   = False
                                     , HcPkg.flagPackageConf = False
                                     , HcPkg.useSingleFileDb = True
                                     }
      where
        Just lhcPkgProg = lookupProgram lhcPkgProgram conf