GHC.hs 17.5 KB
Newer Older
1 2 3 4
module Distribution.Simple.Program.GHC (
    GhcOptions(..),
    GhcMode(..),
    GhcOptimisation(..),
5
    GhcDynLinkMode(..),
6 7 8 9 10 11 12 13 14 15 16

    ghcInvocation,
    renderGhcOptions,

    runGHC,

  ) where

import Distribution.Package
import Distribution.ModuleName
import Distribution.Simple.Compiler hiding (Flag)
17 18
import Distribution.Simple.Setup    ( Flag(..), flagToMaybe, fromFlagOrDefault,
                                      flagToList )
19 20 21 22 23 24
--import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
import Distribution.Text
import Distribution.Verbosity
import Distribution.Version
25
import Language.Haskell.Extension   ( Language(..), Extension(..) )
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55

import Data.Monoid

-- | A structured set of GHC options/flags
--
data GhcOptions = GhcOptions {

  -- | The major mode for the ghc invocation.
  ghcOptMode          :: Flag GhcMode,

  -- | Any extra options to pass directly to ghc. These go at the end and hence
  -- override other stuff.
  ghcOptExtra         :: [String],

  -- | Extra default flags to pass directly to ghc. These go at the beginning
  -- and so can be overridden by other stuff.
  ghcOptExtraDefault  :: [String],

  -----------------------
  -- Inputs and outputs

  -- | The main input files; could be .hs, .hi, .c, .o, depending on mode.
  ghcOptInputFiles    :: [FilePath],

  -- | The names of input Haskell modules, mainly for @--make@ mode.
  ghcOptInputModules  :: [ModuleName],

  -- | Location for output file; the @ghc -o@ flag.
  ghcOptOutputFile    :: Flag FilePath,

56 57 58 59
  -- | Location for dynamic output file in 'GhcStaticAndDynamic' mode;
  -- the @ghc -dyno@ flag.
  ghcOptOutputDynFile :: Flag FilePath,

60 61
  -- | Start with an empty search path for Haskell source files;
  -- the @ghc -i@ flag (@-i@ on it's own with no path argument).
62 63 64 65 66 67 68 69
  ghcOptSourcePathClear :: Flag Bool,

  -- | Search path for Haskell source files; the @ghc -i@ flag.
  ghcOptSourcePath    :: [FilePath],

  -------------
  -- Packages

70 71
  -- | The package key the modules will belong to; the @ghc -this-package-key@ flag
  ghcOptPackageKey   :: Flag PackageKey,
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104

  -- | GHC package databases to use, the @ghc -package-conf@ flag
  ghcOptPackageDBs    :: PackageDBStack,

  -- | The GHC packages to use. For compatability with old and new ghc, this
  -- requires both the short and long form of the package id;
  -- the @ghc -package@ or @ghc -package-id@ flags.
  ghcOptPackages      :: [(InstalledPackageId, PackageId)],

  -- | Start with a clean package set; the @ghc -hide-all-packages@ flag
  ghcOptHideAllPackages :: Flag Bool,

  -- | Don't automatically link in Haskell98 etc; the @ghc -no-auto-link-packages@ flag.
  ghcOptNoAutoLinkPackages :: Flag Bool,

  -----------------
  -- Linker stuff

  -- | Names of libraries to link in; the @ghc -l@ flag.
  ghcOptLinkLibs      :: [FilePath],

  -- | Search path for libraries to link in; the @ghc -L@ flag.
  ghcOptLinkLibPath  :: [FilePath],

  -- | Options to pass through to the linker; the @ghc -optl@ flag.
  ghcOptLinkOptions   :: [String],

  -- | OSX only: frameworks to link in; the @ghc -framework@ flag.
  ghcOptLinkFrameworks :: [String],

  -- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag.
  ghcOptNoLink :: Flag Bool,

105 106 107
  -- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@ flag.
  ghcOptLinkNoHsMain :: Flag Bool,

108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150
  --------------------
  -- C and CPP stuff

  -- | Options to pass through to the C compiler; the @ghc -optc@ flag.
  ghcOptCcOptions     :: [String],

  -- | Options to pass through to CPP; the @ghc -optP@ flag.
  ghcOptCppOptions    :: [String],

  -- | Search path for CPP includes like header files; the @ghc -I@ flag.
  ghcOptCppIncludePath :: [FilePath],

  -- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
  ghcOptCppIncludes    :: [FilePath],

  -- | Extra header files to include for old-style FFI; the @ghc -#include@ flag.
  ghcOptFfiIncludes    :: [FilePath],

  ----------------------------
  -- Language and extensions

  -- | The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag.
  ghcOptLanguage      :: Flag Language,

  -- | The language extensions; the @ghc -X@ flag.
  ghcOptExtensions    :: [Extension],

  -- | A GHC version-dependent mapping of extensions to flags. This must be
  -- set to be able to make use of the 'ghcOptExtensions'.
  ghcOptExtensionMap    :: [(Extension, String)],

  ----------------
  -- Compilation

  -- | What optimisation level to use; the @ghc -O@ flag.
  ghcOptOptimisation  :: Flag GhcOptimisation,

  -- | Compile in profiling mode; the @ghc -prof@ flag.
  ghcOptProfilingMode :: Flag Bool,

  -- | Use the \"split object files\" feature; the @ghc -split-objs@ flag.
  ghcOptSplitObjs     :: Flag Bool,

151 152 153
  -- | Run N jobs simultaneously (if possible).
  ghcOptNumJobs       :: Flag Int,

154 155 156 157 158 159 160 161 162 163 164
  ----------------
  -- GHCi

  -- | Extra GHCi startup scripts; the @-ghci-script@ flag
  ghcOptGHCiScripts    :: [FilePath],

  ------------------------
  -- Redirecting outputs

  ghcOptHiSuffix      :: Flag String,
  ghcOptObjSuffix     :: Flag String,
165 166
  ghcOptDynHiSuffix   :: Flag String,   -- ^ only in 'GhcStaticAndDynamic' mode
  ghcOptDynObjSuffix  :: Flag String,   -- ^ only in 'GhcStaticAndDynamic' mode
167 168
  ghcOptHiDir         :: Flag FilePath,
  ghcOptObjDir        :: Flag FilePath,
169
  ghcOptOutputDir     :: Flag FilePath,
170 171 172 173 174
  ghcOptStubDir       :: Flag FilePath,

  --------------------
  -- Dynamic linking

175
  ghcOptDynLinkMode   :: Flag GhcDynLinkMode,
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
  ghcOptShared        :: Flag Bool,
  ghcOptFPic          :: Flag Bool,
  ghcOptDylibName     :: Flag String,

  ---------------
  -- Misc flags

  -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag.
  ghcOptVerbosity     :: Flag Verbosity,

  -- | Let GHC know that it is Cabal that's calling it.
  -- Modifies some of the GHC error messages.
  ghcOptCabal         :: Flag Bool

} deriving Show


data GhcMode = GhcModeCompile     -- ^ @ghc -c@
             | GhcModeLink        -- ^ @ghc@
             | GhcModeMake        -- ^ @ghc --make@
             | GhcModeInteractive -- ^ @ghci@ \/ @ghc --interactive@
             | GhcModeAbiHash     -- ^ @ghc --abi-hash@
--             | GhcModeDepAnalysis -- ^ @ghc -M@
--             | GhcModeEvaluate    -- ^ @ghc -e@
 deriving (Show, Eq)

data GhcOptimisation = GhcNoOptimisation             -- ^ @-O0@
                     | GhcNormalOptimisation         -- ^ @-O@
                     | GhcMaximumOptimisation        -- ^ @-O2@
                     | GhcSpecialOptimisation String -- ^ e.g. @-Odph@
 deriving (Show, Eq)

208 209 210 211 212
data GhcDynLinkMode = GhcStaticOnly       -- ^ @-static@
                    | GhcDynamicOnly      -- ^ @-dynamic@
                    | GhcStaticAndDynamic -- ^ @-static -dynamic-too@
 deriving (Show, Eq)

213

214 215 216
runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> GhcOptions -> IO ()
runGHC verbosity ghcProg comp opts = do
  runProgramInvocation verbosity (ghcInvocation ghcProg comp opts)
217 218


219 220 221
ghcInvocation :: ConfiguredProgram -> Compiler -> GhcOptions -> ProgramInvocation
ghcInvocation prog comp opts =
    programInvocation prog (renderGhcOptions comp opts)
222 223


224 225 226 227 228 229
renderGhcOptions :: Compiler -> GhcOptions -> [String]
renderGhcOptions comp opts
  | compilerFlavor comp /= GHC =
    error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
    ++ "compiler flavor must be 'GHC'!"
  | otherwise =
230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
  concat
  [ case flagToMaybe (ghcOptMode opts) of
       Nothing                 -> []
       Just GhcModeCompile     -> ["-c"]
       Just GhcModeLink        -> []
       Just GhcModeMake        -> ["--make"]
       Just GhcModeInteractive -> ["--interactive"]
       Just GhcModeAbiHash     -> ["--abi-hash"]
--     Just GhcModeDepAnalysis -> ["-M"]
--     Just GhcModeEvaluate    -> ["-e", expr]

  , flags ghcOptExtraDefault

  , [ "-no-link" | flagBool ghcOptNoLink ]

  ---------------
  -- Misc flags

  , maybe [] verbosityOpts (flagToMaybe (ghcOptVerbosity opts))

  , [ "-fbuilding-cabal-package" | flagBool ghcOptCabal, ver >= [6,11] ]

  ----------------
  -- Compilation

  , case flagToMaybe (ghcOptOptimisation opts) of
      Nothing                         -> []
      Just GhcNoOptimisation          -> ["-O0"]
      Just GhcNormalOptimisation      -> ["-O"]
      Just GhcMaximumOptimisation     -> ["-O2"]
      Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph

  , [ "-prof" | flagBool ghcOptProfilingMode ]

  , [ "-split-objs" | flagBool ghcOptSplitObjs ]

266

267 268 269 270 271
  , if parmakeSupported comp
    then
      let numJobs = fromFlagOrDefault 1 (ghcOptNumJobs opts)
      in if numJobs > 1 then ["-j" ++ show numJobs] else []
    else []
272

273 274 275 276
  --------------------
  -- Dynamic linking

  , [ "-shared"  | flagBool ghcOptShared  ]
277 278 279 280 281
  , case flagToMaybe (ghcOptDynLinkMode opts) of
      Nothing                  -> []
      Just GhcStaticOnly       -> ["-static"]
      Just GhcDynamicOnly      -> ["-dynamic"]
      Just GhcStaticAndDynamic -> ["-static", "-dynamic-too"]
282 283 284 285 286 287 288 289 290
  , [ "-fPIC"    | flagBool ghcOptFPic ]

  , concat [ ["-dylib-install-name", libname] | libname <- flag ghcOptDylibName ]

  ------------------------
  -- Redirecting outputs

  , concat [ ["-osuf",    suf] | suf <- flag ghcOptObjSuffix ]
  , concat [ ["-hisuf",   suf] | suf <- flag ghcOptHiSuffix  ]
291 292
  , concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ]
  , concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix  ]
293
  , concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir, ver >= [6,10] ]
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
  , concat [ ["-odir",    dir] | dir <- flag ghcOptObjDir ]
  , concat [ ["-hidir",   dir] | dir <- flag ghcOptHiDir  ]
  , concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir, ver >= [6,8] ]

  -----------------------
  -- Source search path

  , [ "-i"        | flagBool ghcOptSourcePathClear ]
  , [ "-i" ++ dir | dir <- flags ghcOptSourcePath ]

  --------------------
  -- C and CPP stuff

  , [ "-I"    ++ dir | dir <- flags ghcOptCppIncludePath ]
  , [ "-optP" ++ opt | opt <- flags ghcOptCppOptions ]
  , concat [ [ "-optP-include", "-optP" ++ inc] | inc <- flags ghcOptCppIncludes ]
  , [ "-#include \"" ++ inc ++ "\"" | inc <- flags ghcOptFfiIncludes, ver < [6,11] ]
  , [ "-optc" ++ opt | opt <- flags ghcOptCcOptions ]

  -----------------
  -- Linker stuff

  , [ "-optl" ++ opt | opt <- flags ghcOptLinkOptions ]
  , ["-l" ++ lib     | lib <- flags ghcOptLinkLibs ]
  , ["-L" ++ dir     | dir <- flags ghcOptLinkLibPath ]
  , concat [ ["-framework", fmwk] | fmwk <- flags ghcOptLinkFrameworks ]
320
  , [ "-no-hs-main"  | flagBool ghcOptLinkNoHsMain ]
321 322 323 324

  -------------
  -- Packages

325 326 327 328
  , concat [ [if packageKeySupported comp
                then "-this-package-key"
                else "-package-name", display pkgid]
             | pkgid <- flag ghcOptPackageKey ]
329 330 331 332

  , [ "-hide-all-packages"     | flagBool ghcOptHideAllPackages ]
  , [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ]

333
  , packageDbArgs version (flags ghcOptPackageDBs)
334 335 336 337 338 339 340 341

  , concat $ if ver >= [6,11]
      then [ ["-package-id", display ipkgid] | (ipkgid,_) <- flags ghcOptPackages ]
      else [ ["-package",    display  pkgid] | (_,pkgid)  <- flags ghcOptPackages ]

  ----------------------------
  -- Language and extensions

342 343 344
  , if ver >= [7]
    then [ "-X" ++ display lang | lang <- flag ghcOptLanguage ]
    else []
345 346 347

  , [ case lookup ext (ghcOptExtensionMap opts) of
        Just arg -> arg
348 349
        Nothing  -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
                          ++ display ext ++ " not present in ghcOptExtensionMap."
350 351 352 353 354 355 356 357 358 359 360 361 362 363
    | ext <- ghcOptExtensions opts ]

  ----------------
  -- GHCi

  , concat [ [ "-ghci-script", script ] | script <- flags  ghcOptGHCiScripts
                                        , ver >= [7,2] ]

  ---------------
  -- Inputs

  , [ display modu | modu <- flags ghcOptInputModules ]
  , ghcOptInputFiles opts

364 365
  , concat [ [ "-o",    out] | out <- flag ghcOptOutputFile ]
  , concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ]
366 367 368 369 370 371 372 373 374 375 376 377 378 379

  ---------------
  -- Extra

  , ghcOptExtra opts

  ]


  where
    flag     flg = flagToList (flg opts)
    flags    flg = flg opts
    flagBool flg = fromFlagOrDefault False (flg opts)

380
    version@(Version ver _) = compilerVersion comp
381 382 383 384 385 386 387 388

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


389 390
packageDbArgs :: Version -> PackageDBStack -> [String]
packageDbArgs (Version ver _) dbstack = case dbstack of
391
  (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
392
  (GlobalPackageDB:dbs)               -> ("-no-user-" ++ packageDbFlag)
393 394 395
                                       : concatMap specific dbs
  _ -> ierror
  where
396
    specific (SpecificPackageDB db) = [ '-':packageDbFlag , db ]
397 398 399 400
    specific _ = ierror
    ierror     = error $ "internal error: unexpected package db stack: "
                      ++ show dbstack

401 402 403 404 405 406
    packageDbFlag
      | ver < [7,5]
      = "package-conf"
      | otherwise
      = "package-db"

407 408 409 410 411 412 413 414 415 416 417 418

-- -----------------------------------------------------------------------------
-- Boilerplate Monoid instance for GhcOptions

instance Monoid GhcOptions where
  mempty = GhcOptions {
    ghcOptMode               = mempty,
    ghcOptExtra              = mempty,
    ghcOptExtraDefault       = mempty,
    ghcOptInputFiles         = mempty,
    ghcOptInputModules       = mempty,
    ghcOptOutputFile         = mempty,
419
    ghcOptOutputDynFile      = mempty,
420 421
    ghcOptSourcePathClear    = mempty,
    ghcOptSourcePath         = mempty,
422
    ghcOptPackageKey         = mempty,
423 424 425 426 427 428 429 430 431
    ghcOptPackageDBs         = mempty,
    ghcOptPackages           = mempty,
    ghcOptHideAllPackages    = mempty,
    ghcOptNoAutoLinkPackages = mempty,
    ghcOptLinkLibs           = mempty,
    ghcOptLinkLibPath        = mempty,
    ghcOptLinkOptions        = mempty,
    ghcOptLinkFrameworks     = mempty,
    ghcOptNoLink             = mempty,
432
    ghcOptLinkNoHsMain       = mempty,
433 434 435 436 437 438 439 440 441 442 443
    ghcOptCcOptions          = mempty,
    ghcOptCppOptions         = mempty,
    ghcOptCppIncludePath     = mempty,
    ghcOptCppIncludes        = mempty,
    ghcOptFfiIncludes        = mempty,
    ghcOptLanguage           = mempty,
    ghcOptExtensions         = mempty,
    ghcOptExtensionMap       = mempty,
    ghcOptOptimisation       = mempty,
    ghcOptProfilingMode      = mempty,
    ghcOptSplitObjs          = mempty,
444
    ghcOptNumJobs            = mempty,
445 446 447
    ghcOptGHCiScripts        = mempty,
    ghcOptHiSuffix           = mempty,
    ghcOptObjSuffix          = mempty,
448 449
    ghcOptDynHiSuffix        = mempty,
    ghcOptDynObjSuffix       = mempty,
450 451
    ghcOptHiDir              = mempty,
    ghcOptObjDir             = mempty,
452
    ghcOptOutputDir          = mempty,
453
    ghcOptStubDir            = mempty,
454
    ghcOptDynLinkMode        = mempty,
455 456 457 458 459 460 461 462 463 464 465 466 467
    ghcOptShared             = mempty,
    ghcOptFPic               = mempty,
    ghcOptDylibName          = mempty,
    ghcOptVerbosity          = mempty,
    ghcOptCabal              = mempty
  }
  mappend a b = GhcOptions {
    ghcOptMode               = combine ghcOptMode,
    ghcOptExtra              = combine ghcOptExtra,
    ghcOptExtraDefault       = combine ghcOptExtraDefault,
    ghcOptInputFiles         = combine ghcOptInputFiles,
    ghcOptInputModules       = combine ghcOptInputModules,
    ghcOptOutputFile         = combine ghcOptOutputFile,
468
    ghcOptOutputDynFile      = combine ghcOptOutputDynFile,
469 470
    ghcOptSourcePathClear    = combine ghcOptSourcePathClear,
    ghcOptSourcePath         = combine ghcOptSourcePath,
471
    ghcOptPackageKey         = combine ghcOptPackageKey,
472 473 474 475 476 477 478 479 480
    ghcOptPackageDBs         = combine ghcOptPackageDBs,
    ghcOptPackages           = combine ghcOptPackages,
    ghcOptHideAllPackages    = combine ghcOptHideAllPackages,
    ghcOptNoAutoLinkPackages = combine ghcOptNoAutoLinkPackages,
    ghcOptLinkLibs           = combine ghcOptLinkLibs,
    ghcOptLinkLibPath        = combine ghcOptLinkLibPath,
    ghcOptLinkOptions        = combine ghcOptLinkOptions,
    ghcOptLinkFrameworks     = combine ghcOptLinkFrameworks,
    ghcOptNoLink             = combine ghcOptNoLink,
481
    ghcOptLinkNoHsMain       = combine ghcOptLinkNoHsMain,
482 483 484 485 486 487 488 489 490 491 492
    ghcOptCcOptions          = combine ghcOptCcOptions,
    ghcOptCppOptions         = combine ghcOptCppOptions,
    ghcOptCppIncludePath     = combine ghcOptCppIncludePath,
    ghcOptCppIncludes        = combine ghcOptCppIncludes,
    ghcOptFfiIncludes        = combine ghcOptFfiIncludes,
    ghcOptLanguage           = combine ghcOptLanguage,
    ghcOptExtensions         = combine ghcOptExtensions,
    ghcOptExtensionMap       = combine ghcOptExtensionMap,
    ghcOptOptimisation       = combine ghcOptOptimisation,
    ghcOptProfilingMode      = combine ghcOptProfilingMode,
    ghcOptSplitObjs          = combine ghcOptSplitObjs,
493
    ghcOptNumJobs            = combine ghcOptNumJobs,
494 495 496
    ghcOptGHCiScripts        = combine ghcOptGHCiScripts,
    ghcOptHiSuffix           = combine ghcOptHiSuffix,
    ghcOptObjSuffix          = combine ghcOptObjSuffix,
497 498
    ghcOptDynHiSuffix        = combine ghcOptDynHiSuffix,
    ghcOptDynObjSuffix       = combine ghcOptDynObjSuffix,
499 500
    ghcOptHiDir              = combine ghcOptHiDir,
    ghcOptObjDir             = combine ghcOptObjDir,
501
    ghcOptOutputDir          = combine ghcOptOutputDir,
502
    ghcOptStubDir            = combine ghcOptStubDir,
503
    ghcOptDynLinkMode        = combine ghcOptDynLinkMode,
504 505 506 507 508 509 510 511
    ghcOptShared             = combine ghcOptShared,
    ghcOptFPic               = combine ghcOptFPic,
    ghcOptDylibName          = combine ghcOptDylibName,
    ghcOptVerbosity          = combine ghcOptVerbosity,
    ghcOptCabal              = combine ghcOptCabal
  }
    where
      combine field = field a `mappend` field b