Cabal/Distribution/Simple/GHC.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Distribution.Simple.GHC
   4 -- Copyright   :  Isaac Jones 2003-2007
   5 --
   6 -- Maintainer  :  cabal-devel@haskell.org
   7 -- Portability :  portable
   8 --
   9 -- This is a fairly large module. It contains most of the GHC-specific code for
  10 -- configuring, building and installing packages. It also exports a function
  11 -- for finding out what packages are already installed. Configuring involves
  12 -- finding the @ghc@ and @ghc-pkg@ programs, finding what language extensions
  13 -- this version of ghc supports and returning a 'Compiler' value.
  14 --
  15 -- 'getInstalledPackages' involves calling the @ghc-pkg@ program to find out
  16 -- what packages are installed.
  17 --
  18 -- Building is somewhat complex as there is quite a bit of information to take
  19 -- into account. We have to build libs and programs, possibly for profiling and
  20 -- shared libs. We have to support building libraries that will be usable by
  21 -- GHCi and also ghc's @-split-objs@ feature. We have to compile any C files
  22 -- using ghc. Linking, especially for @split-objs@ is remarkably complex,
  23 -- partly because there tend to be 1,000's of @.o@ files and this can often be
  24 -- more than we can pass to the @ld@ or @ar@ programs in one go.
  25 --
  26 -- Installing for libs and exes involves finding the right files and copying
  27 -- them to the right places. One of the more tricky things about this module is
  28 -- remembering the layout of files in the build directory (which is not
  29 -- explicitly documented) and thus what search dirs are used for various kinds
  30 -- of files.
  31
  32 {- Copyright (c) 2003-2005, Isaac Jones
  33 All rights reserved.
  34
  35 Redistribution and use in source and binary forms, with or without
  36 modiication, are permitted provided that the following conditions are
  37 met:
  38
  39     * Redistributions of source code must retain the above copyright
  40       notice, this list of conditions and the following disclaimer.
  41
  42     * Redistributions in binary form must reproduce the above
  43       copyright notice, this list of conditions and the following
  44       disclaimer in the documentation and/or other materials provided
  45       with the distribution.
  46
  47     * Neither the name of Isaac Jones nor the names of other
  48       contributors may be used to endorse or promote products derived
  49       from this software without specific prior written permission.
  50
  51 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  52 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  53 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  54 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  55 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  56 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  57 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  58 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  59 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  60 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  61 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
  62
  63 module Distribution.Simple.GHC (
  64         getGhcInfo,
  65         configure, getInstalledPackages, getPackageDBContents,
  66         buildLib, buildExe,
  67         replLib, replExe,
  68         installLib, installExe,
  69         libAbiHash,
  70         initPackageDB,
  71         invokeHcPkg,
  72         registerPackage,
  73         componentGhcOptions,
  74         ghcLibDir,
  75         ghcDynamic,
  76  ) where
  77
  78 import qualified Distribution.Simple.GHC.IPI641 as IPI641
  79 import qualified Distribution.Simple.GHC.IPI642 as IPI642
  80 import Distribution.PackageDescription as PD
  81          ( PackageDescription(..), BuildInfo(..), Executable(..)
  82          , Library(..), libModules, exeModules, hcOptions
  83          , usedExtensions, allExtensions )
  84 import Distribution.InstalledPackageInfo
  85          ( InstalledPackageInfo )
  86 import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo
  87                                 ( InstalledPackageInfo_(..) )
  88 import Distribution.Simple.PackageIndex (PackageIndex)
  89 import qualified Distribution.Simple.PackageIndex as PackageIndex
  90 import Distribution.Simple.LocalBuildInfo
  91          ( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
  92          , LibraryName(..), absoluteInstallDirs )
  93 import Distribution.Simple.InstallDirs hiding ( absoluteInstallDirs )
  94 import Distribution.Simple.BuildPaths
  95 import Distribution.Simple.Utils
  96 import Distribution.Package
  97          ( Package(..), PackageName(..) )
  98 import qualified Distribution.ModuleName as ModuleName
  99 import Distribution.Simple.Program
 100          ( Program(..), ConfiguredProgram(..), ProgramConfiguration
 101          , ProgramLocation(..), ProgramSearchPath, ProgramSearchPathEntry(..)
 102          , rawSystemProgram
 103          , rawSystemProgramStdout, rawSystemProgramStdoutConf
 104          , getProgramOutput, getProgramInvocationOutput, suppressOverrideArgs
 105          , requireProgramVersion, requireProgram
 106          , userMaybeSpecifyPath, programPath, lookupProgram, addKnownProgram
 107          , ghcProgram, ghcPkgProgram, hsc2hsProgram
 108          , arProgram, ranlibProgram, ldProgram
 109          , gccProgram, stripProgram )
 110 import qualified Distribution.Simple.Program.HcPkg as HcPkg
 111 import qualified Distribution.Simple.Program.Ar    as Ar
 112 import qualified Distribution.Simple.Program.Ld    as Ld
 113 import Distribution.Simple.Program.GHC
 114 import Distribution.Simple.Setup (toFlag, fromFlag)
 115 import Distribution.Simple.Compiler
 116          ( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
 117          , OptimisationLevel(..), PackageDB(..), PackageDBStack
 118          , Flag )
 119 import Distribution.Version
 120          ( Version(..), anyVersion, orLaterVersion )
 121 import Distribution.System
 122          ( Platform(..), OS(..), buildOS, platformFromTriple )
 123 import Distribution.Verbosity
 124 import Distribution.Text
 125          ( display, simpleParse )
 126 import Language.Haskell.Extension (Language(..), Extension(..)
 127                                   ,KnownExtension(..))
 128
 129 import Control.Monad            ( unless, when )
 130 import Data.Char                ( isSpace )
 131 import Data.List
 132 import Data.Maybe               ( catMaybes, fromMaybe )
 133 import Data.Monoid              ( Monoid(..) )
 134 import System.Directory
 135          ( removeFile, getDirectoryContents, doesFileExist
 136          , getTemporaryDirectory )
 137 import System.FilePath          ( (</>), (<.>), takeExtension,
 138                                   takeDirectory, replaceExtension,
 139                                   splitExtension )
 140 import System.IO (hClose, hPutStrLn)
 141 import System.Environment (getEnv)
 142 import Distribution.Compat.Exception (catchExit, catchIO)
 143
 144
 145 -- -----------------------------------------------------------------------------
 146 -- Configuring
 147
 148 configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
 149           -> ProgramConfiguration
 150           -> IO (Compiler, Maybe Platform, ProgramConfiguration)
 151 configure verbosity hcPath hcPkgPath conf0 = do
 152
 153   (ghcProg, ghcVersion, conf1) <-
 154     requireProgramVersion verbosity ghcProgram
 155       (orLaterVersion (Version [6,4] []))
 156       (userMaybeSpecifyPath "ghc" hcPath conf0)
 157
 158   -- This is slightly tricky, we have to configure ghc first, then we use the
 159   -- location of ghc to help find ghc-pkg in the case that the user did not
 160   -- specify the location of ghc-pkg directly:
 161   (ghcPkgProg, ghcPkgVersion, conf2) <-
 162     requireProgramVersion verbosity ghcPkgProgram {
 163       programFindLocation = guessGhcPkgFromGhcPath ghcProg
 164     }
 165     anyVersion (userMaybeSpecifyPath "ghc-pkg" hcPkgPath conf1)
 166
 167   when (ghcVersion /= ghcPkgVersion) $ die $
 168        "Version mismatch between ghc and ghc-pkg: "
 169     ++ programPath ghcProg ++ " is version " ++ display ghcVersion ++ " "
 170     ++ programPath ghcPkgProg ++ " is version " ++ display ghcPkgVersion
 171
 172   -- Likewise we try to find the matching hsc2hs program.
 173   let hsc2hsProgram' = hsc2hsProgram {
 174                            programFindLocation = guessHsc2hsFromGhcPath ghcProg
 175                        }
 176       conf3 = addKnownProgram hsc2hsProgram' conf2
 177
 178   languages  <- getLanguages verbosity ghcProg
 179   extensions <- getExtensions verbosity ghcProg
 180
 181   ghcInfo <- getGhcInfo verbosity ghcProg
 182
 183   let comp = Compiler {
 184         compilerId             = CompilerId GHC ghcVersion,
 185         compilerLanguages      = languages,
 186         compilerExtensions     = extensions
 187       }
 188       compPlatform = targetPlatform ghcInfo
 189       conf4 = configureToolchain ghcProg ghcInfo conf3 -- configure gcc and ld
 190   return (comp, compPlatform, conf4)
 191
 192 targetPlatform :: [(String, String)] -> Maybe Platform
 193 targetPlatform ghcInfo = platformFromTriple =<< lookup "Target platform" ghcInfo
 194
 195 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find
 196 -- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking
 197 -- for a versioned or unversioned ghc-pkg in the same dir, that is:
 198 --
 199 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
 200 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
 201 -- > /usr/local/bin/ghc-pkg(.exe)
 202 --
 203 guessToolFromGhcPath :: Program -> ConfiguredProgram
 204                      -> Verbosity -> ProgramSearchPath
 205                      -> IO (Maybe FilePath)
 206 guessToolFromGhcPath tool ghcProg verbosity searchpath
 207   = do let toolname          = programName tool
 208            path              = programPath ghcProg
 209            dir               = takeDirectory path
 210            versionSuffix     = takeVersionSuffix (dropExeExtension path)
 211            guessNormal       = dir </> toolname <.> exeExtension
 212            guessGhcVersioned = dir </> (toolname ++ "-ghc" ++ versionSuffix)
 213                                <.> exeExtension
 214            guessVersioned    = dir </> (toolname ++ versionSuffix)
 215                                <.> exeExtension
 216            guesses | null versionSuffix = [guessNormal]
 217                    | otherwise          = [guessGhcVersioned,
 218                                            guessVersioned,
 219                                            guessNormal]
 220        info verbosity $ "looking for tool " ++ toolname
 221          ++ " near compiler in " ++ dir
 222        exists <- mapM doesFileExist guesses
 223        case [ file | (file, True) <- zip guesses exists ] of
 224                    -- If we can't find it near ghc, fall back to the usual
 225                    -- method.
 226          []     -> programFindLocation tool verbosity searchpath
 227          (fp:_) -> do info verbosity $ "found " ++ toolname ++ " in " ++ fp
 228                       return (Just fp)
 229
 230   where takeVersionSuffix :: FilePath -> String
 231         takeVersionSuffix = reverse . takeWhile (`elem ` "0123456789.-") .
 232                             reverse
 233
 234         dropExeExtension :: FilePath -> FilePath
 235         dropExeExtension filepath =
 236           case splitExtension filepath of
 237             (filepath', extension) | extension == exeExtension -> filepath'
 238                                    | otherwise                 -> filepath
 239
 240 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 241 -- corresponding ghc-pkg, we try looking for both a versioned and unversioned
 242 -- ghc-pkg in the same dir, that is:
 243 --
 244 -- > /usr/local/bin/ghc-pkg-ghc-6.6.1(.exe)
 245 -- > /usr/local/bin/ghc-pkg-6.6.1(.exe)
 246 -- > /usr/local/bin/ghc-pkg(.exe)
 247 --
 248 guessGhcPkgFromGhcPath :: ConfiguredProgram
 249                        -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
 250 guessGhcPkgFromGhcPath = guessToolFromGhcPath ghcPkgProgram
 251
 252 -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find a
 253 -- corresponding hsc2hs, we try looking for both a versioned and unversioned
 254 -- hsc2hs in the same dir, that is:
 255 --
 256 -- > /usr/local/bin/hsc2hs-ghc-6.6.1(.exe)
 257 -- > /usr/local/bin/hsc2hs-6.6.1(.exe)
 258 -- > /usr/local/bin/hsc2hs(.exe)
 259 --
 260 guessHsc2hsFromGhcPath :: ConfiguredProgram
 261                        -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
 262 guessHsc2hsFromGhcPath = guessToolFromGhcPath hsc2hsProgram
 263
 264 -- | Adjust the way we find and configure gcc and ld
 265 --
 266 configureToolchain :: ConfiguredProgram -> [(String, String)]
 267                                         -> ProgramConfiguration
 268                                         -> ProgramConfiguration
 269 configureToolchain ghcProg ghcInfo =
 270     addKnownProgram gccProgram {
 271       programFindLocation = findProg gccProgram extraGccPath,
 272       programPostConf     = configureGcc
 273     }
 274   . addKnownProgram ldProgram {
 275       programFindLocation = findProg ldProgram extraLdPath,
 276       programPostConf     = configureLd
 277     }
 278   . addKnownProgram arProgram {
 279       programFindLocation = findProg arProgram extraArPath
 280     }
 281   . addKnownProgram stripProgram {
 282       programFindLocation = findProg stripProgram extraStripPath
 283     }
 284   where
 285     Just ghcVersion = programVersion ghcProg
 286     compilerDir = takeDirectory (programPath ghcProg)
 287     baseDir     = takeDirectory compilerDir
 288     mingwBinDir = baseDir </> "mingw" </> "bin"
 289     libDir      = baseDir </> "gcc-lib"
 290     includeDir  = baseDir </> "include" </> "mingw"
 291     isWindows   = case buildOS of Windows -> True; _ -> False
 292     binPrefix   = ""
 293
 294     -- on Windows finding and configuring ghc's gcc & binutils is a bit special
 295     extraGccPath
 296       | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix ++ "gcc.exe"
 297       | otherwise                       = baseDir     </> "gcc.exe"
 298     extraLdPath
 299       | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix ++ "ld.exe"
 300       | otherwise                       = libDir      </> "ld.exe"
 301     extraArPath
 302       | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix ++ "ar.exe"
 303       | otherwise                       = libDir      </> "ar.exe"
 304     extraStripPath
 305       | ghcVersion >= Version [6,12] [] = mingwBinDir </> binPrefix ++
 306                                           "strip.exe"
 307       | otherwise                       = libDir      </> "strip.exe"
 308
 309     findProg :: Program -> FilePath
 310              -> Verbosity -> ProgramSearchPath -> IO (Maybe FilePath)
 311     findProg prog extraPath v searchpath =
 312         programFindLocation prog v searchpath'
 313       where
 314         searchpath' | isWindows = ProgramSearchPathDir extraPath : searchpath
 315                     | otherwise = searchpath
 316
 317     ccFlags        = getFlags "C compiler flags"
 318     gccLinkerFlags = getFlags "Gcc Linker flags"
 319     ldLinkerFlags  = getFlags "Ld Linker flags"
 320
 321     getFlags key = case lookup key ghcInfo of
 322                    Nothing -> []
 323                    Just flags ->
 324                        case reads flags of
 325                        [(args, "")] -> args
 326                        _ -> [] -- XXX Should should be an error really
 327
 328     configureGcc :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
 329     configureGcc v gccProg = do
 330       gccProg' <- configureGcc' v gccProg
 331       return gccProg' {
 332         programDefaultArgs = programDefaultArgs gccProg'
 333                              ++ ccFlags ++ gccLinkerFlags
 334       }
 335
 336     configureGcc' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
 337     configureGcc'
 338       | isWindows = \_ gccProg -> case programLocation gccProg of
 339           -- if it's found on system then it means we're using the result
 340           -- of programFindLocation above rather than a user-supplied path
 341           -- Pre GHC 6.12, that meant we should add these flags to tell
 342           -- ghc's gcc where it lives and thus where gcc can find its
 343           -- various files:
 344           FoundOnSystem {}
 345            | ghcVersion < Version [6,11] [] ->
 346                return gccProg { programDefaultArgs = ["-B" ++ libDir,
 347                                                       "-I" ++ includeDir] }
 348           _ -> return gccProg
 349       | otherwise = \_ gccProg -> return gccProg
 350
 351     configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
 352     configureLd v ldProg = do
 353       ldProg' <- configureLd' v ldProg
 354       return ldProg' {
 355         programDefaultArgs = programDefaultArgs ldProg' ++ ldLinkerFlags
 356       }
 357
 358     -- we need to find out if ld supports the -x flag
 359     configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram
 360     configureLd' verbosity ldProg = do
 361       tempDir <- getTemporaryDirectory
 362       ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->
 363              withTempFile tempDir ".o" $ \testofile testohnd -> do
 364                hPutStrLn testchnd "int foo() { return 0; }"
 365                hClose testchnd; hClose testohnd
 366                rawSystemProgram verbosity ghcProg ["-c", testcfile,
 367                                                    "-o", testofile]
 368                withTempFile tempDir ".o" $ \testofile' testohnd' ->
 369                  do
 370                    hClose testohnd'
 371                    _ <- rawSystemProgramStdout verbosity ldProg
 372                      ["-x", "-r", testofile, "-o", testofile']
 373                    return True
 374                  `catchIO`   (\_ -> return False)
 375                  `catchExit` (\_ -> return False)
 376       if ldx
 377         then return ldProg { programDefaultArgs = ["-x"] }
 378         else return ldProg
 379
 380 getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, Flag)]
 381 getLanguages _ ghcProg
 382   -- TODO: should be using --supported-languages rather than hard coding
 383   | ghcVersion >= Version [7] [] = return [(Haskell98,   "-XHaskell98")
 384                                           ,(Haskell2010, "-XHaskell2010")]
 385   | otherwise                    = return [(Haskell98,   "")]
 386   where
 387     Just ghcVersion = programVersion ghcProg
 388
 389 getGhcInfo :: Verbosity -> ConfiguredProgram -> IO [(String, String)]
 390 getGhcInfo verbosity ghcProg =
 391     case programVersion ghcProg of
 392     Just ghcVersion
 393      | ghcVersion >= Version [6,7] [] ->
 394         do xs <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
 395                  ["--info"]
 396            case reads xs of
 397                [(i, ss)]
 398                 | all isSpace ss ->
 399                    return i
 400                _ ->
 401                    die "Can't parse --info output of GHC"
 402     _ ->
 403         return []
 404
 405 getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Flag)]
 406 getExtensions verbosity ghcProg
 407   | ghcVersion >= Version [6,7] [] = do
 408
 409     str <- getProgramOutput verbosity (suppressOverrideArgs ghcProg)
 410               ["--supported-languages"]
 411     let extStrs = if ghcVersion >= Version [7] []
 412                   then lines str
 413                   else -- Older GHCs only gave us either Foo or NoFoo,
 414                        -- so we have to work out the other one ourselves
 415                        [ extStr''
 416                        | extStr <- lines str
 417                        , let extStr' = case extStr of
 418                                        'N' : 'o' : xs -> xs
 419                                        _              -> "No" ++ extStr
 420                        , extStr'' <- [extStr, extStr']
 421                        ]
 422     let extensions0 = [ (ext, "-X" ++ display ext)
 423                       | Just ext <- map simpleParse extStrs ]
 424         extensions1 = if ghcVersion >= Version [6,8]  [] &&
 425                          ghcVersion <  Version [6,10] []
 426                       then -- ghc-6.8 introduced RecordPuns however it
 427                            -- should have been NamedFieldPuns. We now
 428                            -- encourage packages to use NamedFieldPuns
 429                            -- so for compatability we fake support for
 430                            -- it in ghc-6.8 by making it an alias for
 431                            -- the old RecordPuns extension.
 432                            (EnableExtension  NamedFieldPuns, "-XRecordPuns") :
 433                            (DisableExtension NamedFieldPuns, "-XNoRecordPuns") :
 434                            extensions0
 435                       else extensions0
 436         extensions2 = if ghcVersion <  Version [7,1] []
 437                       then -- ghc-7.2 split NondecreasingIndentation off
 438                            -- into a proper extension. Before that it
 439                            -- was always on.
 440                            (EnableExtension  NondecreasingIndentation, "") :
 441                            (DisableExtension NondecreasingIndentation, "") :
 442                            extensions1
 443                       else extensions1
 444     return extensions2
 445
 446   | otherwise = return oldLanguageExtensions
 447
 448   where
 449     Just ghcVersion = programVersion ghcProg
 450
 451 -- | For GHC 6.6.x and earlier, the mapping from supported extensions to flags
 452 oldLanguageExtensions :: [(Extension, Flag)]
 453 oldLanguageExtensions =
 454     let doFlag (f, (enable, disable)) = [(EnableExtension  f, enable),
 455                                          (DisableExtension f, disable)]
 456         fglasgowExts = ("-fglasgow-exts",
 457                         "") -- This is wrong, but we don't want to turn
 458                             -- all the extensions off when asked to just
 459                             -- turn one off
 460         fFlag flag = ("-f" ++ flag, "-fno-" ++ flag)
 461     in concatMap doFlag
 462     [(OverlappingInstances       , fFlag "allow-overlapping-instances")
 463     ,(TypeSynonymInstances       , fglasgowExts)
 464     ,(TemplateHaskell            , fFlag "th")
 465     ,(ForeignFunctionInterface   , fFlag "ffi")
 466     ,(MonomorphismRestriction    , fFlag "monomorphism-restriction")
 467     ,(MonoPatBinds               , fFlag "mono-pat-binds")
 468     ,(UndecidableInstances       , fFlag "allow-undecidable-instances")
 469     ,(IncoherentInstances        , fFlag "allow-incoherent-instances")
 470     ,(Arrows                     , fFlag "arrows")
 471     ,(Generics                   , fFlag "generics")
 472     ,(ImplicitPrelude            , fFlag "implicit-prelude")
 473     ,(ImplicitParams             , fFlag "implicit-params")
 474     ,(CPP                        , ("-cpp", ""{- Wrong -}))
 475     ,(BangPatterns               , fFlag "bang-patterns")
 476     ,(KindSignatures             , fglasgowExts)
 477     ,(RecursiveDo                , fglasgowExts)
 478     ,(ParallelListComp           , fglasgowExts)
 479     ,(MultiParamTypeClasses      , fglasgowExts)
 480     ,(FunctionalDependencies     , fglasgowExts)
 481     ,(Rank2Types                 , fglasgowExts)
 482     ,(RankNTypes                 , fglasgowExts)
 483     ,(PolymorphicComponents      , fglasgowExts)
 484     ,(ExistentialQuantification  , fglasgowExts)
 485     ,(ScopedTypeVariables        , fFlag "scoped-type-variables")
 486     ,(FlexibleContexts           , fglasgowExts)
 487     ,(FlexibleInstances          , fglasgowExts)
 488     ,(EmptyDataDecls             , fglasgowExts)
 489     ,(PatternGuards              , fglasgowExts)
 490     ,(GeneralizedNewtypeDeriving , fglasgowExts)
 491     ,(MagicHash                  , fglasgowExts)
 492     ,(UnicodeSyntax              , fglasgowExts)
 493     ,(PatternSignatures          , fglasgowExts)
 494     ,(UnliftedFFITypes           , fglasgowExts)
 495     ,(LiberalTypeSynonyms        , fglasgowExts)
 496     ,(TypeOperators              , fglasgowExts)
 497     ,(GADTs                      , fglasgowExts)
 498     ,(RelaxedPolyRec             , fglasgowExts)
 499     ,(ExtendedDefaultRules       , fFlag "extended-default-rules")
 500     ,(UnboxedTuples              , fglasgowExts)
 501     ,(DeriveDataTypeable         , fglasgowExts)
 502     ,(ConstrainedClassMethods    , fglasgowExts)
 503     ]
 504 -- | Given a single package DB, return all installed packages.
 505 getPackageDBContents :: Verbosity -> PackageDB -> ProgramConfiguration
 506                         -> IO PackageIndex
 507 getPackageDBContents verbosity packagedb conf = do
 508   pkgss <- getInstalledPackages' verbosity [packagedb] conf
 509   toPackageIndex verbosity pkgss conf
 510
 511 -- | Given a package DB stack, return all installed packages.
 512 getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramConfiguration
 513                      -> IO PackageIndex
 514 getInstalledPackages verbosity packagedbs conf = do
 515   checkPackageDbEnvVar
 516   checkPackageDbStack packagedbs
 517   pkgss <- getInstalledPackages' verbosity packagedbs conf
 518   index <- toPackageIndex verbosity pkgss conf
 519   return $! hackRtsPackage index
 520
 521   where
 522     hackRtsPackage index =
 523       case PackageIndex.lookupPackageName index (PackageName "rts") of
 524         [(_,[rts])]
 525            -> PackageIndex.insert (removeMingwIncludeDir rts) index
 526         _  -> index -- No (or multiple) ghc rts package is registered!!
 527                     -- Feh, whatever, the ghc testsuite does some crazy stuff.
 528
 529 -- | Given a list of @(PackageDB, InstalledPackageInfo)@ pairs, produce a
 530 -- @PackageIndex@. Helper function used by 'getPackageDBContents' and
 531 -- 'getInstalledPackages'.
 532 toPackageIndex :: Verbosity
 533                -> [(PackageDB, [InstalledPackageInfo])]
 534                -> ProgramConfiguration
 535                -> IO PackageIndex
 536 toPackageIndex verbosity pkgss conf = do
 537   -- On Windows, various fields have $topdir/foo rather than full
 538   -- paths. We need to substitute the right value in so that when
 539   -- we, for example, call gcc, we have proper paths to give it.
 540   topDir <- ghcLibDir' verbosity ghcProg
 541   let indices = [ PackageIndex.fromList (map (substTopDir topDir) pkgs)
 542                 | (_, pkgs) <- pkgss ]
 543   return $! (mconcat indices)
 544
 545   where
 546     Just ghcProg = lookupProgram ghcProgram conf
 547
 548 ghcLibDir :: Verbosity -> LocalBuildInfo -> IO FilePath
 549 ghcLibDir verbosity lbi =
 550     (reverse . dropWhile isSpace . reverse) `fmap`
 551      rawSystemProgramStdoutConf verbosity ghcProgram
 552      (withPrograms lbi) ["--print-libdir"]
 553
 554 ghcLibDir' :: Verbosity -> ConfiguredProgram -> IO FilePath
 555 ghcLibDir' verbosity ghcProg =
 556     (reverse . dropWhile isSpace . reverse) `fmap`
 557      rawSystemProgramStdout verbosity ghcProg ["--print-libdir"]
 558
 559 -- Cabal does not use the environment variable GHC_PACKAGE_PATH; let users
 560 -- know that this is the case. See ticket #335. Simply ignoring it is not a
 561 -- good idea, since then ghc and cabal are looking at different sets of
 562 -- package dbs and chaos is likely to ensue.
 563 checkPackageDbEnvVar :: IO ()
 564 checkPackageDbEnvVar = do
 565     hasGPP <- (getEnv "GHC_PACKAGE_PATH" >> return True)
 566               `catchIO` (\_ -> return False)
 567     when hasGPP $
 568       die $ "Use of GHC's environment variable GHC_PACKAGE_PATH is "
 569          ++ "incompatible with Cabal. Use the flag --package-db to specify a "
 570          ++ "package database (it can be used multiple times)."
 571
 572 checkPackageDbStack :: PackageDBStack -> IO ()
 573 checkPackageDbStack (GlobalPackageDB:rest)
 574   | GlobalPackageDB `notElem` rest = return ()
 575 checkPackageDbStack rest
 576   | GlobalPackageDB `notElem` rest =
 577   die $ "With current ghc versions the global package db is always used "
 578      ++ "and must be listed first. This ghc limitation may be lifted in "
 579      ++ "future, see http://hackage.haskell.org/trac/ghc/ticket/5977"
 580 checkPackageDbStack _ =
 581   die $ "If the global package db is specified, it must be "
 582      ++ "specified first and cannot be specified multiple times"
 583
 584 -- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This
 585 -- breaks when you want to use a different gcc, so we need to filter
 586 -- it out.
 587 removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo
 588 removeMingwIncludeDir pkg =
 589     let ids = InstalledPackageInfo.includeDirs pkg
 590         ids' = filter (not . ("mingw" `isSuffixOf`)) ids
 591     in pkg { InstalledPackageInfo.includeDirs = ids' }
 592
 593 -- | Get the packages from specific PackageDBs, not cumulative.
 594 --
 595 getInstalledPackages' :: Verbosity -> [PackageDB] -> ProgramConfiguration
 596                      -> IO [(PackageDB, [InstalledPackageInfo])]
 597 getInstalledPackages' verbosity packagedbs conf
 598   | ghcVersion >= Version [6,9] [] =
 599   sequence
 600     [ do pkgs <- HcPkg.dump verbosity ghcPkgProg packagedb
 601          return (packagedb, pkgs)
 602     | packagedb <- packagedbs ]
 603
 604   where
 605     Just ghcPkgProg = lookupProgram ghcPkgProgram conf
 606     Just ghcProg    = lookupProgram ghcProgram conf
 607     Just ghcVersion = programVersion ghcProg
 608
 609 getInstalledPackages' verbosity packagedbs conf = do
 610     str <- rawSystemProgramStdoutConf verbosity ghcPkgProgram conf ["list"]
 611     let pkgFiles = [ init line | line <- lines str, last line == ':' ]
 612         dbFile packagedb = case (packagedb, pkgFiles) of
 613           (GlobalPackageDB, global:_)      -> return $ Just global
 614           (UserPackageDB,  _global:user:_) -> return $ Just user
 615           (UserPackageDB,  _global:_)      -> return $ Nothing
 616           (SpecificPackageDB specific, _)  -> return $ Just specific
 617           _ -> die "cannot read ghc-pkg package listing"
 618     pkgFiles' <- mapM dbFile packagedbs
 619     sequence [ withFileContents file $ \content -> do
 620                   pkgs <- readPackages file content
 621                   return (db, pkgs)
 622              | (db , Just file) <- zip packagedbs pkgFiles' ]
 623   where
 624     -- Depending on the version of ghc we use a different type's Read
 625     -- instance to parse the package file and then convert.
 626     -- It's a bit yuck. But that's what we get for using Read/Show.
 627     readPackages
 628       | ghcVersion >= Version [6,4,2] []
 629       = \file content -> case reads content of
 630           [(pkgs, _)] -> return (map IPI642.toCurrent pkgs)
 631           _           -> failToRead file
 632       | otherwise
 633       = \file content -> case reads content of
 634           [(pkgs, _)] -> return (map IPI641.toCurrent pkgs)
 635           _           -> failToRead file
 636     Just ghcProg = lookupProgram ghcProgram conf
 637     Just ghcVersion = programVersion ghcProg
 638     failToRead file = die $ "cannot read ghc package database " ++ file
 639
 640 substTopDir :: FilePath -> InstalledPackageInfo -> InstalledPackageInfo
 641 substTopDir topDir ipo
 642  = ipo {
 643        InstalledPackageInfo.importDirs
 644            = map f (InstalledPackageInfo.importDirs ipo),
 645        InstalledPackageInfo.libraryDirs
 646            = map f (InstalledPackageInfo.libraryDirs ipo),
 647        InstalledPackageInfo.includeDirs
 648            = map f (InstalledPackageInfo.includeDirs ipo),
 649        InstalledPackageInfo.frameworkDirs
 650            = map f (InstalledPackageInfo.frameworkDirs ipo),
 651        InstalledPackageInfo.haddockInterfaces
 652            = map f (InstalledPackageInfo.haddockInterfaces ipo),
 653        InstalledPackageInfo.haddockHTMLs
 654            = map f (InstalledPackageInfo.haddockHTMLs ipo)
 655    }
 656     where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
 657           f x = x
 658
 659 -- -----------------------------------------------------------------------------
 660 -- Building
 661
 662 -- | Build a library with GHC.
 663 --
 664 buildLib, replLib :: Verbosity
 665                   -> PackageDescription -> LocalBuildInfo
 666                   -> Library            -> ComponentLocalBuildInfo -> IO ()
 667 buildLib = buildOrReplLib False
 668 replLib  = buildOrReplLib True
 669
 670 buildOrReplLib :: Bool -> Verbosity
 671                -> PackageDescription -> LocalBuildInfo
 672                -> Library            -> ComponentLocalBuildInfo -> IO ()
 673 buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
 674   libName <- case componentLibraries clbi of
 675              [libName] -> return libName
 676              [] -> die "No library name found when building library"
 677              _  -> die "Multiple library names found when building library"
 678
 679   let libTargetDir = buildDir lbi
 680       pkgid = packageId pkg_descr
 681       whenVanillaLib forceVanilla =
 682         when (not forRepl && (forceVanilla || withVanillaLib lbi))
 683       whenProfLib = when (not forRepl && withProfLib lbi)
 684       whenSharedLib forceShared =
 685         when (not forRepl &&  (forceShared || withSharedLib lbi))
 686       whenGHCiLib = when (not forRepl && withGHCiLib lbi && withVanillaLib lbi)
 687       ifReplLib = when forRepl
 688       comp = compiler lbi
 689       ghcVersion = compilerVersion comp
 690       (Platform _hostArch hostOS) = hostPlatform lbi
 691
 692   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
 693   let runGhcProg = runGHC verbosity ghcProg
 694
 695   libBi <- hackThreadedFlag verbosity
 696              comp (withProfLib lbi) (libBuildInfo lib)
 697
 698   isGhcDynamic <- ghcDynamic verbosity ghcProg
 699   dynamicTooSupported <- ghcSupportsDynamicToo verbosity ghcProg
 700   let doingTH = EnableExtension TemplateHaskell `elem` allExtensions libBi
 701       forceVanillaLib = doingTH && not isGhcDynamic
 702       forceSharedLib  = doingTH &&     isGhcDynamic
 703       -- TH always needs default libs, even when building for profiling
 704
 705   createDirectoryIfMissingVerbose verbosity True libTargetDir
 706   -- TODO: do we need to put hs-boot files into place for mutually recursive
 707   -- modules?
 708   let cObjs       = map (`replaceExtension` objExtension) (cSources libBi)
 709       baseOpts    = componentGhcOptions verbosity lbi libBi clbi libTargetDir
 710       vanillaOpts = baseOpts `mappend` mempty {
 711                       ghcOptMode         = toFlag GhcModeMake,
 712                       ghcOptPackageName  = toFlag pkgid,
 713                       ghcOptInputModules = libModules lib
 714                     }
 715
 716       profOpts    = vanillaOpts `mappend` mempty {
 717                       ghcOptProfilingMode = toFlag True,
 718                       ghcOptHiSuffix      = toFlag "p_hi",
 719                       ghcOptObjSuffix     = toFlag "p_o",
 720                       ghcOptExtra         = ghcProfOptions libBi
 721                     }
 722
 723       sharedOpts  = vanillaOpts `mappend` mempty {
 724                       ghcOptDynLinkMode = toFlag GhcDynamicOnly,
 725                       ghcOptFPic        = toFlag True,
 726                       ghcOptHiSuffix    = toFlag "dyn_hi",
 727                       ghcOptObjSuffix   = toFlag "dyn_o",
 728                       ghcOptExtra       = ghcSharedOptions libBi
 729                     }
 730       linkerOpts = mempty {
 731                       ghcOptLinkOptions    = PD.ldOptions libBi,
 732                       ghcOptLinkLibs       = extraLibs libBi,
 733                       ghcOptLinkLibPath    = extraLibDirs libBi,
 734                       ghcOptLinkFrameworks = PD.frameworks libBi,
 735                       ghcOptInputFiles     = [libTargetDir </> x | x <- cObjs]
 736                    }
 737       replOpts    = vanillaOpts {
 738                       ghcOptExtra        = filterGhciFlags
 739                                            (ghcOptExtra vanillaOpts)
 740                     }
 741                     `mappend` linkerOpts
 742                     `mappend` mempty {
 743                       ghcOptMode         = toFlag GhcModeInteractive,
 744                       ghcOptOptimisation = toFlag GhcNoOptimisation
 745                     }
 746
 747       vanillaSharedOpts = vanillaOpts `mappend` mempty {
 748                       ghcOptDynLinkMode  = toFlag GhcStaticAndDynamic,
 749                       ghcOptDynHiSuffix  = toFlag "dyn_hi",
 750                       ghcOptDynObjSuffix = toFlag "dyn_o"
 751                     }
 752
 753   unless (null (libModules lib)) $
 754     do let vanilla = whenVanillaLib forceVanillaLib (runGhcProg vanillaOpts)
 755            shared  = whenSharedLib  forceSharedLib  (runGhcProg sharedOpts)
 756            useDynToo = dynamicTooSupported &&
 757                        (forceVanillaLib || withVanillaLib lbi) &&
 758                        (forceSharedLib  || withSharedLib  lbi) &&
 759                        null (ghcSharedOptions libBi)
 760        if useDynToo
 761            then runGhcProg vanillaSharedOpts
 762            else if isGhcDynamic then do shared;  vanilla
 763                                 else do vanilla; shared
 764        whenProfLib (runGhcProg profOpts)
 765
 766   -- build any C sources
 767   unless (null (cSources libBi)) $ do
 768      info verbosity "Building C Sources..."
 769      sequence_
 770        [ do let baseCcOpts    = componentCcGhcOptions verbosity lbi
 771                                 libBi clbi libTargetDir filename
 772                 vanillaCcOpts = if isGhcDynamic
 773                                 -- Dynamic GHC requires C sources to be built
 774                                 -- with -fPIC for REPL to work. See #2207.
 775                                 then baseCcOpts { ghcOptFPic = toFlag True }
 776                                 else baseCcOpts
 777                 profCcOpts    = vanillaCcOpts `mappend` mempty {
 778                                   ghcOptProfilingMode = toFlag True,
 779                                   ghcOptObjSuffix     = toFlag "p_o"
 780                                 }
 781                 sharedCcOpts  = vanillaCcOpts `mappend` mempty {
 782                                   ghcOptFPic        = toFlag True,
 783                                   ghcOptDynLinkMode = toFlag GhcDynamicOnly,
 784                                   ghcOptObjSuffix   = toFlag "dyn_o"
 785                                 }
 786                 odir          = fromFlag (ghcOptObjDir vanillaCcOpts)
 787             createDirectoryIfMissingVerbose verbosity True odir
 788             runGhcProg vanillaCcOpts
 789             whenSharedLib forceSharedLib (runGhcProg sharedCcOpts)
 790             whenProfLib (runGhcProg profCcOpts)
 791        | filename <- cSources libBi]
 792
 793   -- TODO: problem here is we need the .c files built first, so we can load them
 794   -- with ghci, but .c files can depend on .h files generated by ghc by ffi
 795   -- exports.
 796   unless (null (libModules lib)) $
 797      ifReplLib (runGhcProg replOpts)
 798
 799
 800   -- link:
 801   info verbosity "Linking..."
 802   let cProfObjs   = map (`replaceExtension` ("p_" ++ objExtension))
 803                     (cSources libBi)
 804       cSharedObjs = map (`replaceExtension` ("dyn_" ++ objExtension))
 805                     (cSources libBi)
 806       cid = compilerId (compiler lbi)
 807       vanillaLibFilePath = libTargetDir </> mkLibName           libName
 808       profileLibFilePath = libTargetDir </> mkProfLibName       libName
 809       sharedLibFilePath  = libTargetDir </> mkSharedLibName cid libName
 810       ghciLibFilePath    = libTargetDir </> mkGHCiLibName       libName
 811       libInstallPath = libdir $ absoluteInstallDirs pkg_descr lbi NoCopyDest
 812       sharedLibInstallPath = libInstallPath </> mkSharedLibName cid libName
 813
 814   stubObjs <- fmap catMaybes $ sequence
 815     [ findFileWithExtension [objExtension] [libTargetDir]
 816         (ModuleName.toFilePath x ++"_stub")
 817     | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
 818     , x <- libModules lib ]
 819   stubProfObjs <- fmap catMaybes $ sequence
 820     [ findFileWithExtension ["p_" ++ objExtension] [libTargetDir]
 821         (ModuleName.toFilePath x ++"_stub")
 822     | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
 823     , x <- libModules lib ]
 824   stubSharedObjs <- fmap catMaybes $ sequence
 825     [ findFileWithExtension ["dyn_" ++ objExtension] [libTargetDir]
 826         (ModuleName.toFilePath x ++"_stub")
 827     | ghcVersion < Version [7,2] [] -- ghc-7.2+ does not make _stub.o files
 828     , x <- libModules lib ]
 829
 830   hObjs     <- getHaskellObjects lib lbi
 831                     libTargetDir objExtension True
 832   hProfObjs <-
 833     if (withProfLib lbi)
 834             then getHaskellObjects lib lbi
 835                     libTargetDir ("p_" ++ objExtension) True
 836             else return []
 837   hSharedObjs <-
 838     if (withSharedLib lbi)
 839             then getHaskellObjects lib lbi
 840                     libTargetDir ("dyn_" ++ objExtension) False
 841             else return []
 842
 843   unless (null hObjs && null cObjs && null stubObjs) $ do
 844     -- first remove library files if they exists
 845     unless forRepl $ sequence_
 846       [ removeFile libFilePath `catchIO` \_ -> return ()
 847       | libFilePath <- [vanillaLibFilePath, profileLibFilePath
 848                        ,sharedLibFilePath,  ghciLibFilePath] ]
 849
 850     let staticObjectFiles =
 851                hObjs
 852             ++ map (libTargetDir </>) cObjs
 853             ++ stubObjs
 854         profObjectFiles =
 855                hProfObjs
 856             ++ map (libTargetDir </>) cProfObjs
 857             ++ stubProfObjs
 858         ghciObjFiles =
 859                hObjs
 860             ++ map (libTargetDir </>) cObjs
 861             ++ stubObjs
 862         dynamicObjectFiles =
 863                hSharedObjs
 864             ++ map (libTargetDir </>) cSharedObjs
 865             ++ stubSharedObjs
 866         -- After the relocation lib is created we invoke ghc -shared
 867         -- with the dependencies spelled out as -package arguments
 868         -- and ghc invokes the linker with the proper library paths
 869         ghcSharedLinkArgs =
 870             mempty {
 871               ghcOptShared             = toFlag True,
 872               ghcOptDynLinkMode        = toFlag GhcDynamicOnly,
 873               ghcOptInputFiles         = dynamicObjectFiles,
 874               ghcOptOutputFile         = toFlag sharedLibFilePath,
 875               -- For dynamic libs, Mac OS/X needs to know the install location
 876               -- at build time. This only applies to GHC < 7.8 - see the
 877               -- discussion in #1660.
 878               ghcOptDylibName          = if (hostOS == OSX
 879                                              && ghcVersion < Version [7,8] [])
 880                                           then toFlag sharedLibInstallPath
 881                                           else mempty,
 882               ghcOptPackageName        = toFlag pkgid,
 883               ghcOptNoAutoLinkPackages = toFlag True,
 884               ghcOptPackageDBs         = withPackageDB lbi,
 885               ghcOptPackages           = componentPackageDeps clbi,
 886               ghcOptLinkLibs           = extraLibs libBi,
 887               ghcOptLinkLibPath        = extraLibDirs libBi
 888             }
 889
 890     whenVanillaLib False $ do
 891       (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
 892       Ar.createArLibArchive verbosity arProg
 893         vanillaLibFilePath staticObjectFiles
 894
 895     whenProfLib $ do
 896       (arProg, _) <- requireProgram verbosity arProgram (withPrograms lbi)
 897       Ar.createArLibArchive verbosity arProg
 898         profileLibFilePath profObjectFiles
 899
 900     whenGHCiLib $ do
 901       (ldProg, _) <- requireProgram verbosity ldProgram (withPrograms lbi)
 902       Ld.combineObjectFiles verbosity ldProg
 903         ghciLibFilePath ghciObjFiles
 904
 905     whenSharedLib False $
 906       runGhcProg ghcSharedLinkArgs
 907
 908
 909 -- | Build an executable with GHC.
 910 --
 911 buildExe, replExe :: Verbosity
 912                   -> PackageDescription -> LocalBuildInfo
 913                   -> Executable         -> ComponentLocalBuildInfo -> IO ()
 914 buildExe = buildOrReplExe False
 915 replExe  = buildOrReplExe True
 916
 917 buildOrReplExe :: Bool -> Verbosity
 918                -> PackageDescription -> LocalBuildInfo
 919                -> Executable         -> ComponentLocalBuildInfo -> IO ()
 920 buildOrReplExe forRepl verbosity _pkg_descr lbi
 921   exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
 922
 923   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
 924   let runGhcProg = runGHC verbosity ghcProg
 925
 926   exeBi <- hackThreadedFlag verbosity
 927              (compiler lbi) (withProfExe lbi) (buildInfo exe)
 928
 929   -- exeNameReal, the name that GHC really uses (with .exe on Windows)
 930   let exeNameReal = exeName' <.>
 931                     (if takeExtension exeName' /= ('.':exeExtension)
 932                        then exeExtension
 933                        else "")
 934
 935   let targetDir = (buildDir lbi) </> exeName'
 936   let exeDir    = targetDir </> (exeName' ++ "-tmp")
 937   createDirectoryIfMissingVerbose verbosity True targetDir
 938   createDirectoryIfMissingVerbose verbosity True exeDir
 939   -- TODO: do we need to put hs-boot files into place for mutually recursive
 940   -- modules?  FIX: what about exeName.hi-boot?
 941
 942   -- build executables
 943
 944   srcMainFile         <- findFile (exeDir : hsSourceDirs exeBi) modPath
 945   isGhcDynamic        <- ghcDynamic verbosity ghcProg
 946   dynamicTooSupported <- ghcSupportsDynamicToo verbosity ghcProg
 947
 948   let isHaskellMain = elem (takeExtension srcMainFile) [".hs", ".lhs"]
 949       cSrcs         = cSources exeBi ++ [srcMainFile | not isHaskellMain]
 950       cObjs         = map (`replaceExtension` objExtension) cSrcs
 951       baseOpts   = (componentGhcOptions verbosity lbi exeBi clbi exeDir)
 952                     `mappend` mempty {
 953                       ghcOptMode         = toFlag GhcModeMake,
 954                       ghcOptInputFiles   =
 955                         [ srcMainFile | isHaskellMain],
 956                       ghcOptInputModules =
 957                         [ m | not isHaskellMain, m <- exeModules exe]
 958                     }
 959       staticOpts = baseOpts `mappend` mempty {
 960                       ghcOptDynLinkMode    = toFlag GhcStaticOnly
 961                    }
 962       profOpts   = baseOpts `mappend` mempty {
 963                       ghcOptProfilingMode  = toFlag True,
 964                       ghcOptHiSuffix       = toFlag "p_hi",
 965                       ghcOptObjSuffix      = toFlag "p_o",
 966                       ghcOptExtra          = ghcProfOptions exeBi
 967                     }
 968       dynOpts    = baseOpts `mappend` mempty {
 969                       ghcOptDynLinkMode    = toFlag GhcDynamicOnly,
 970                       ghcOptHiSuffix       = toFlag "dyn_hi",
 971                       ghcOptObjSuffix      = toFlag "dyn_o",
 972                       ghcOptExtra          = ghcSharedOptions exeBi
 973                     }
 974       dynTooOpts = staticOpts `mappend` mempty {
 975                       ghcOptDynLinkMode    = toFlag GhcStaticAndDynamic,
 976                       ghcOptDynHiSuffix    = toFlag "dyn_hi",
 977                       ghcOptDynObjSuffix   = toFlag "dyn_o"
 978                     }
 979       linkerOpts = mempty {
 980                       ghcOptLinkOptions    = PD.ldOptions exeBi,
 981                       ghcOptLinkLibs       = extraLibs exeBi,
 982                       ghcOptLinkLibPath    = extraLibDirs exeBi,
 983                       ghcOptLinkFrameworks = PD.frameworks exeBi,
 984                       ghcOptInputFiles     = [exeDir </> x | x <- cObjs]
 985                    }
 986       replOpts   = baseOpts {
 987                       ghcOptExtra          = filterGhciFlags
 988                                              (ghcOptExtra baseOpts)
 989                    }
 990                    -- For a normal compile we do separate invocations of ghc for
 991                    -- compiling as for linking. But for repl we have to do just
 992                    -- the one invocation, so that one has to include all the
 993                    -- linker stuff too, like -l flags and any .o files from C
 994                    -- files etc.
 995                    `mappend` linkerOpts
 996                    `mappend` mempty {
 997                       ghcOptMode           = toFlag GhcModeInteractive,
 998                       ghcOptOptimisation   = toFlag GhcNoOptimisation
 999                    }
1000       commonOpts  | withProfExe lbi = profOpts
1001                   | withDynExe  lbi = dynOpts
1002                   | otherwise       = staticOpts
1003       compileOpts | useDynToo = dynTooOpts
1004                   | otherwise = commonOpts
1005       withStaticExe = (not $ withProfExe lbi) && (not $ withDynExe lbi)
1006
1007       -- For building exe's that use TH with -prof or -dynamic we actually have
1008       -- to build twice, once without -prof/-dynamic and then again with
1009       -- -prof/-dynamic. This is because the code that TH needs to run at
1010       -- compile time needs to be the vanilla ABI so it can be loaded up and run
1011       -- by the compiler.
1012       -- With dynamic-by-default GHC the TH object files loaded at compile-time
1013       -- need to be .dyn_o instead of .o.
1014       doingTH = EnableExtension TemplateHaskell `elem` allExtensions exeBi
1015       -- Should we use -dynamic-too instead of compilng twice?
1016       useDynToo = dynamicTooSupported && isGhcDynamic
1017                   && doingTH && withStaticExe && null (ghcSharedOptions exeBi)
1018       compileTHOpts | isGhcDynamic = dynOpts
1019                     | otherwise    = staticOpts
1020       compileForTH
1021         | forRepl      = False
1022         | useDynToo    = False
1023         | isGhcDynamic = doingTH && (withProfExe lbi || withStaticExe)
1024         | otherwise    = doingTH && (withProfExe lbi || withDynExe lbi)
1025
1026       linkOpts = commonOpts `mappend`
1027                  linkerOpts `mappend` mempty {
1028                       ghcOptLinkNoHsMain   = toFlag (not isHaskellMain)
1029                  }
1030
1031   -- Build static/dynamic object files for TH, if needed.
1032   when compileForTH $
1033     runGhcProg compileTHOpts { ghcOptNoLink = toFlag True }
1034
1035   unless forRepl $
1036     runGhcProg compileOpts { ghcOptNoLink = toFlag True }
1037
1038   -- build any C sources
1039   unless (null cSrcs) $ do
1040    info verbosity "Building C Sources..."
1041    sequence_
1042      [ do let opts = (componentCcGhcOptions verbosity lbi exeBi clbi
1043                          exeDir filename) `mappend` mempty {
1044                        ghcOptDynLinkMode   = toFlag (if withDynExe lbi
1045                                                        then GhcDynamicOnly
1046                                                        else GhcStaticOnly),
1047                        ghcOptProfilingMode = toFlag (withProfExe lbi)
1048                      }
1049               odir = fromFlag (ghcOptObjDir opts)
1050           createDirectoryIfMissingVerbose verbosity True odir
1051           runGhcProg opts
1052      | filename <- cSrcs ]
1053
1054   -- TODO: problem here is we need the .c files built first, so we can load them
1055   -- with ghci, but .c files can depend on .h files generated by ghc by ffi
1056   -- exports.
1057   when forRepl $ runGhcProg replOpts
1058
1059   -- link:
1060   unless forRepl $ do
1061     info verbosity "Linking..."
1062     runGhcProg linkOpts { ghcOptOutputFile = toFlag (targetDir </> exeNameReal) }
1063
1064
1065 -- | Filter the "-threaded" flag when profiling as it does not
1066 --   work with ghc-6.8 and older.
1067 hackThreadedFlag :: Verbosity -> Compiler -> Bool -> BuildInfo -> IO BuildInfo
1068 hackThreadedFlag verbosity comp prof bi
1069   | not mustFilterThreaded = return bi
1070   | otherwise              = do
1071     warn verbosity $ "The ghc flag '-threaded' is not compatible with "
1072                   ++ "profiling in ghc-6.8 and older. It will be disabled."
1073     return bi { options = filterHcOptions (/= "-threaded") (options bi) }
1074   where
1075     mustFilterThreaded = prof && compilerVersion comp < Version [6, 10] []
1076                       && "-threaded" `elem` hcOptions GHC bi
1077     filterHcOptions p hcoptss =
1078       [ (hc, if hc == GHC then filter p opts else opts)
1079       | (hc, opts) <- hcoptss ]
1080
1081 -- | Strip out flags that are not supported in ghci
1082 filterGhciFlags :: [String] -> [String]
1083 filterGhciFlags = filter supported
1084   where
1085     supported ('-':'O':_) = False
1086     supported "-debug"    = False
1087     supported "-threaded" = False
1088     supported "-ticky"    = False
1089     supported "-eventlog" = False
1090     supported "-prof"     = False
1091     supported "-unreg"    = False
1092     supported _           = True
1093
1094 -- when using -split-objs, we need to search for object files in the
1095 -- Module_split directory for each module.
1096 getHaskellObjects :: Library -> LocalBuildInfo
1097                   -> FilePath -> String -> Bool -> IO [FilePath]
1098 getHaskellObjects lib lbi pref wanted_obj_ext allow_split_objs
1099   | splitObjs lbi && allow_split_objs = do
1100         let splitSuffix = if compilerVersion (compiler lbi) <
1101                              Version [6, 11] []
1102                           then "_split"
1103                           else "_" ++ wanted_obj_ext ++ "_split"
1104             dirs = [ pref </> (ModuleName.toFilePath x ++ splitSuffix)
1105                    | x <- libModules lib ]
1106         objss <- mapM getDirectoryContents dirs
1107         let objs = [ dir </> obj
1108                    | (objs',dir) <- zip objss dirs, obj <- objs',
1109                      let obj_ext = takeExtension obj,
1110                      '.':wanted_obj_ext == obj_ext ]
1111         return objs
1112   | otherwise  =
1113         return [ pref </> ModuleName.toFilePath x <.> wanted_obj_ext
1114                | x <- libModules lib ]
1115
1116 -- | Extracts a String representing a hash of the ABI of a built
1117 -- library.  It can fail if the library has not yet been built.
1118 --
1119 libAbiHash :: Verbosity -> PackageDescription -> LocalBuildInfo
1120            -> Library -> ComponentLocalBuildInfo -> IO String
1121 libAbiHash verbosity pkg_descr lbi lib clbi = do
1122   libBi <- hackThreadedFlag verbosity
1123              (compiler lbi) (withProfLib lbi) (libBuildInfo lib)
1124   let
1125       vanillaArgs =
1126         (componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
1127         `mappend` mempty {
1128           ghcOptMode         = toFlag GhcModeAbiHash,
1129           ghcOptPackageName  = toFlag (packageId pkg_descr),
1130           ghcOptInputModules = exposedModules lib
1131         }
1132       sharedArgs = vanillaArgs `mappend` mempty {
1133                        ghcOptDynLinkMode = toFlag GhcDynamicOnly,
1134                        ghcOptFPic        = toFlag True,
1135                        ghcOptHiSuffix    = toFlag "dyn_hi",
1136                        ghcOptObjSuffix   = toFlag "dyn_o",
1137                        ghcOptExtra       = ghcSharedOptions libBi
1138                    }
1139       profArgs = vanillaArgs `mappend` mempty {
1140                      ghcOptProfilingMode = toFlag True,
1141                      ghcOptHiSuffix      = toFlag "p_hi",
1142                      ghcOptObjSuffix     = toFlag "p_o",
1143                      ghcOptExtra         = ghcProfOptions libBi
1144                  }
1145       ghcArgs = if withVanillaLib lbi then vanillaArgs
1146            else if withSharedLib  lbi then sharedArgs
1147            else if withProfLib    lbi then profArgs
1148            else error "libAbiHash: Can't find an enabled library way"
1149   --
1150   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
1151   getProgramInvocationOutput verbosity (ghcInvocation ghcProg ghcArgs)
1152
1153
1154 componentGhcOptions :: Verbosity -> LocalBuildInfo
1155                     -> BuildInfo -> ComponentLocalBuildInfo -> FilePath
1156                     -> GhcOptions
1157 componentGhcOptions verbosity lbi bi clbi odir =
1158     mempty {
1159       ghcOptVerbosity       = toFlag verbosity,
1160       ghcOptHideAllPackages = toFlag True,
1161       ghcOptCabal           = toFlag True,
1162       ghcOptPackageDBs      = withPackageDB lbi,
1163       ghcOptPackages        = componentPackageDeps clbi,
1164       ghcOptSplitObjs       = toFlag (splitObjs lbi),
1165       ghcOptSourcePathClear = toFlag True,
1166       ghcOptSourcePath      = [odir] ++ nub (hsSourceDirs bi)
1167                                     ++ [autogenModulesDir lbi],
1168       ghcOptCppIncludePath  = [autogenModulesDir lbi, odir]
1169                                     ++ PD.includeDirs bi,
1170       ghcOptCppOptions      = cppOptions bi,
1171       ghcOptCppIncludes     = [autogenModulesDir lbi </> cppHeaderName],
1172       ghcOptFfiIncludes     = PD.includes bi,
1173       ghcOptObjDir          = toFlag odir,
1174       ghcOptHiDir           = toFlag odir,
1175       ghcOptStubDir         = toFlag odir,
1176       ghcOptOutputDir       = toFlag odir,
1177       ghcOptOptimisation    = toGhcOptimisation (withOptimization lbi),
1178       ghcOptExtra           = hcOptions GHC bi,
1179       ghcOptLanguage        = toFlag (fromMaybe Haskell98 (defaultLanguage bi)),
1180       -- Unsupported extensions have already been checked by configure
1181       ghcOptExtensions      = usedExtensions bi,
1182       ghcOptExtensionMap    = compilerExtensions (compiler lbi)
1183     }
1184   where
1185     toGhcOptimisation NoOptimisation      = mempty --TODO perhaps override?
1186     toGhcOptimisation NormalOptimisation  = toFlag GhcNormalOptimisation
1187     toGhcOptimisation MaximumOptimisation = toFlag GhcMaximumOptimisation
1188
1189
1190 componentCcGhcOptions :: Verbosity -> LocalBuildInfo
1191                       -> BuildInfo -> ComponentLocalBuildInfo
1192                       -> FilePath -> FilePath
1193                       -> GhcOptions
1194 componentCcGhcOptions verbosity lbi bi clbi pref filename =
1195     mempty {
1196       ghcOptVerbosity      = toFlag verbosity,
1197       ghcOptMode           = toFlag GhcModeCompile,
1198       ghcOptInputFiles     = [filename],
1199
1200       ghcOptCppIncludePath = [autogenModulesDir lbi, odir]
1201                                    ++ PD.includeDirs bi,
1202       ghcOptPackageDBs     = withPackageDB lbi,
1203       ghcOptPackages       = componentPackageDeps clbi,
1204       ghcOptCcOptions      = PD.ccOptions bi
1205                              ++ case withOptimization lbi of
1206                                   NoOptimisation -> []
1207                                   _              -> ["-O2"],
1208       ghcOptObjDir         = toFlag odir
1209     }
1210   where
1211     odir | compilerVersion (compiler lbi) >= Version [6,4,1] []  = pref
1212          | otherwise = pref </> takeDirectory filename
1213          -- ghc 6.4.0 had a bug in -odir handling for C compilations.
1214
1215 mkGHCiLibName :: LibraryName -> String
1216 mkGHCiLibName (LibraryName lib) = lib <.> "o"
1217
1218 -- -----------------------------------------------------------------------------
1219 -- Installing
1220
1221 -- |Install executables for GHC.
1222 installExe :: Verbosity
1223            -> LocalBuildInfo
1224            -> InstallDirs FilePath -- ^Where to copy the files to
1225            -> FilePath  -- ^Build location
1226            -> (FilePath, FilePath)  -- ^Executable (prefix,suffix)
1227            -> PackageDescription
1228            -> Executable
1229            -> IO ()
1230 installExe verbosity lbi installDirs buildPref
1231   (progprefix, progsuffix) _pkg exe = do
1232   let binDir = bindir installDirs
1233   createDirectoryIfMissingVerbose verbosity True binDir
1234   let exeFileName = exeName exe <.> exeExtension
1235       fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix
1236       installBinary dest = do
1237           installExecutableFile verbosity
1238             (buildPref </> exeName exe </> exeFileName)
1239             (dest <.> exeExtension)
1240           stripExe verbosity lbi exeFileName (dest <.> exeExtension)
1241   installBinary (binDir </> fixedExeBaseName)
1242
1243 stripExe :: Verbosity -> LocalBuildInfo -> FilePath -> FilePath -> IO ()
1244 stripExe verbosity lbi name path = when (stripExes lbi) $
1245   case lookupProgram stripProgram (withPrograms lbi) of
1246     Just strip -> rawSystemProgram verbosity strip args
1247     Nothing    -> unless (buildOS == Windows) $
1248                   -- Don't bother warning on windows, we don't expect them to
1249                   -- have the strip program anyway.
1250                   warn verbosity $ "Unable to strip executable '" ++ name
1251                                 ++ "' (missing the 'strip' program)"
1252   where
1253     args = path : case buildOS of
1254        OSX -> ["-x"] -- By default, stripping the ghc binary on at least
1255                      -- some OS X installations causes:
1256                      --     HSbase-3.0.o: unknown symbol `_environ'"
1257                      -- The -x flag fixes that.
1258        _   -> []
1259
1260 -- |Install for ghc, .hi, .a and, if --with-ghci given, .o
1261 installLib    :: Verbosity
1262               -> LocalBuildInfo
1263               -> FilePath  -- ^install location
1264               -> FilePath  -- ^install location for dynamic librarys
1265               -> FilePath  -- ^Build location
1266               -> PackageDescription
1267               -> Library
1268               -> ComponentLocalBuildInfo
1269               -> IO ()
1270 installLib verbosity lbi targetDir dynlibTargetDir builtDir _pkg lib clbi = do
1271   -- copy .hi files over:
1272   let copyHelper installFun src dst n = do
1273         createDirectoryIfMissingVerbose verbosity True dst
1274         installFun verbosity (src </> n) (dst </> n)
1275       copy       = copyHelper installOrdinaryFile
1276       copyShared = copyHelper installExecutableFile
1277       copyModuleFiles ext =
1278         findModuleFiles [builtDir] [ext] (libModules lib)
1279           >>= installOrdinaryFiles verbosity targetDir
1280   whenVanilla $ copyModuleFiles "hi"
1281   whenProf    $ copyModuleFiles "p_hi"
1282   whenShared  $ copyModuleFiles "dyn_hi"
1283
1284   -- copy the built library files over:
1285   whenVanilla $ mapM_ (copy builtDir targetDir)             vanillaLibNames
1286   whenProf    $ mapM_ (copy builtDir targetDir)             profileLibNames
1287   whenGHCi    $ mapM_ (copy builtDir targetDir)             ghciLibNames
1288   whenShared  $ mapM_ (copyShared builtDir dynlibTargetDir) sharedLibNames
1289
1290   -- run ranlib if necessary:
1291   whenVanilla $ mapM_ (updateLibArchive verbosity lbi . (targetDir </>))
1292                       vanillaLibNames
1293   whenProf    $ mapM_ (updateLibArchive verbosity lbi . (targetDir </>))
1294                       profileLibNames
1295
1296   where
1297     cid = compilerId (compiler lbi)
1298     libNames = componentLibraries clbi
1299     vanillaLibNames = map mkLibName             libNames
1300     profileLibNames = map mkProfLibName         libNames
1301     ghciLibNames    = map mkGHCiLibName         libNames
1302     sharedLibNames  = map (mkSharedLibName cid) libNames
1303
1304     hasLib    = not $ null (libModules lib)
1305                    && null (cSources (libBuildInfo lib))
1306     whenVanilla = when (hasLib && withVanillaLib lbi)
1307     whenProf    = when (hasLib && withProfLib    lbi)
1308     whenGHCi    = when (hasLib && withGHCiLib    lbi)
1309     whenShared  = when (hasLib && withSharedLib  lbi)
1310
1311 -- | On MacOS X we have to call @ranlib@ to regenerate the archive index after
1312 -- copying. This is because the silly MacOS X linker checks that the archive
1313 -- index is not older than the file itself, which means simply
1314 -- copying/installing the file breaks it!!
1315 --
1316 updateLibArchive :: Verbosity -> LocalBuildInfo -> FilePath -> IO ()
1317 updateLibArchive verbosity lbi path
1318   | buildOS == OSX = do
1319     (ranlib, _) <- requireProgram verbosity ranlibProgram (withPrograms lbi)
1320     rawSystemProgram verbosity ranlib [path]
1321   | otherwise = return ()
1322
1323 -- -----------------------------------------------------------------------------
1324 -- Registering
1325
1326 -- | Create an empty package DB at the specified location.
1327 initPackageDB :: Verbosity -> ProgramConfiguration -> FilePath -> IO ()
1328 initPackageDB verbosity conf dbPath = HcPkg.init verbosity ghcPkgProg dbPath
1329   where
1330     Just ghcPkgProg = lookupProgram ghcPkgProgram conf
1331
1332 -- | Run 'ghc-pkg' using a given package DB stack, directly forwarding the
1333 -- provided command-line arguments to it.
1334 invokeHcPkg :: Verbosity -> ProgramConfiguration -> PackageDBStack -> [String]
1335                -> IO ()
1336 invokeHcPkg verbosity conf dbStack extraArgs =
1337     HcPkg.invoke verbosity ghcPkgProg dbStack extraArgs
1338   where
1339     Just ghcPkgProg = lookupProgram ghcPkgProgram conf
1340
1341 registerPackage
1342   :: Verbosity
1343   -> InstalledPackageInfo
1344   -> PackageDescription
1345   -> LocalBuildInfo
1346   -> Bool
1347   -> PackageDBStack
1348   -> IO ()
1349 registerPackage verbosity installedPkgInfo _pkg lbi _inplace packageDbs = do
1350   let Just ghcPkg = lookupProgram ghcPkgProgram (withPrograms lbi)
1351   HcPkg.reregister verbosity ghcPkg packageDbs (Right installedPkgInfo)
1352
1353 -- -----------------------------------------------------------------------------
1354 -- Utils
1355
1356 ghcDynamic :: Verbosity -> ConfiguredProgram -> IO Bool
1357 ghcDynamic verbosity ghcProg
1358     = do xs <- getGhcInfo verbosity ghcProg
1359          return $ case lookup "GHC Dynamic" xs of
1360                   Just "YES" -> True
1361                   _          -> False
1362
1363 ghcSupportsDynamicToo :: Verbosity -> ConfiguredProgram -> IO Bool
1364 ghcSupportsDynamicToo verbosity ghcProg
1365     = do xs <- getGhcInfo verbosity ghcProg
1366          return $ case lookup "Support dynamic-too" xs of
1367                   Just "YES" -> True
1368                   _          -> False