Cabal-1.22.2.0: Distribution/Simple/Program/GHC.hs
{-# LANGUAGE CPP #-}
module Distribution.Simple.Program.GHC (
GhcOptions(..),
GhcMode(..),
GhcOptimisation(..),
GhcDynLinkMode(..),
ghcInvocation,
renderGhcOptions,
runGHC,
) where
import Distribution.Simple.GHC.ImplInfo ( getImplInfo, GhcImplInfo(..) )
import Distribution.Package
import Distribution.PackageDescription hiding (Flag)
import Distribution.ModuleName
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.Setup ( Flag(..), flagToMaybe, fromFlagOrDefault,
flagToList )
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
import Distribution.Text
import Distribution.Verbosity
import Distribution.Utils.NubList ( NubListR, fromNubListR )
import Language.Haskell.Extension ( Language(..), Extension(..) )
import qualified Data.Map as M
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.List ( intercalate )
-- | 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 :: NubListR String,
-- | Extra default flags to pass directly to ghc. These go at the beginning
-- and so can be overridden by other stuff.
ghcOptExtraDefault :: NubListR String,
-----------------------
-- Inputs and outputs
-- | The main input files; could be .hs, .hi, .c, .o, depending on mode.
ghcOptInputFiles :: NubListR FilePath,
-- | The names of input Haskell modules, mainly for @--make@ mode.
ghcOptInputModules :: NubListR ModuleName,
-- | Location for output file; the @ghc -o@ flag.
ghcOptOutputFile :: Flag FilePath,
-- | Location for dynamic output file in 'GhcStaticAndDynamic' mode;
-- the @ghc -dyno@ flag.
ghcOptOutputDynFile :: Flag FilePath,
-- | Start with an empty search path for Haskell source files;
-- the @ghc -i@ flag (@-i@ on it's own with no path argument).
ghcOptSourcePathClear :: Flag Bool,
-- | Search path for Haskell source files; the @ghc -i@ flag.
ghcOptSourcePath :: NubListR FilePath,
-------------
-- Packages
-- | The package key the modules will belong to; the @ghc -this-package-key@
-- flag.
ghcOptPackageKey :: Flag PackageKey,
-- | 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 ::
NubListR (InstalledPackageId, PackageId, ModuleRenaming),
-- | 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,
-- | What packages are implementing the signatures
ghcOptSigOf :: [(ModuleName, (PackageKey, ModuleName))],
-----------------
-- Linker stuff
-- | Names of libraries to link in; the @ghc -l@ flag.
ghcOptLinkLibs :: NubListR FilePath,
-- | Search path for libraries to link in; the @ghc -L@ flag.
ghcOptLinkLibPath :: NubListR FilePath,
-- | Options to pass through to the linker; the @ghc -optl@ flag.
ghcOptLinkOptions :: NubListR String,
-- | OSX only: frameworks to link in; the @ghc -framework@ flag.
ghcOptLinkFrameworks :: NubListR String,
-- | Don't do the link step, useful in make mode; the @ghc -no-link@ flag.
ghcOptNoLink :: Flag Bool,
-- | Don't link in the normal RTS @main@ entry point; the @ghc -no-hs-main@
-- flag.
ghcOptLinkNoHsMain :: Flag Bool,
--------------------
-- C and CPP stuff
-- | Options to pass through to the C compiler; the @ghc -optc@ flag.
ghcOptCcOptions :: NubListR String,
-- | Options to pass through to CPP; the @ghc -optP@ flag.
ghcOptCppOptions :: NubListR String,
-- | Search path for CPP includes like header files; the @ghc -I@ flag.
ghcOptCppIncludePath :: NubListR FilePath,
-- | Extra header files to include at CPP stage; the @ghc -optP-include@ flag.
ghcOptCppIncludes :: NubListR FilePath,
-- | Extra header files to include for old-style FFI; the @ghc -#include@ flag.
ghcOptFfiIncludes :: NubListR FilePath,
----------------------------
-- Language and extensions
-- | The base language; the @ghc -XHaskell98@ or @-XHaskell2010@ flag.
ghcOptLanguage :: Flag Language,
-- | The language extensions; the @ghc -X@ flag.
ghcOptExtensions :: NubListR Extension,
-- | A GHC version-dependent mapping of extensions to flags. This must be
-- set to be able to make use of the 'ghcOptExtensions'.
ghcOptExtensionMap :: M.Map Extension String,
----------------
-- Compilation
-- | What optimisation level to use; the @ghc -O@ flag.
ghcOptOptimisation :: Flag GhcOptimisation,
-- | Emit debug info; the @ghc -g@ flag.
ghcOptDebugInfo :: Flag Bool,
-- | 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,
-- | Run N jobs simultaneously (if possible).
ghcOptNumJobs :: Flag (Maybe Int),
-- | Enable coverage analysis; the @ghc -fhpc -hpcdir@ flags.
ghcOptHPCDir :: Flag FilePath,
----------------
-- GHCi
-- | Extra GHCi startup scripts; the @-ghci-script@ flag
ghcOptGHCiScripts :: NubListR FilePath,
------------------------
-- Redirecting outputs
ghcOptHiSuffix :: Flag String,
ghcOptObjSuffix :: Flag String,
ghcOptDynHiSuffix :: Flag String, -- ^ only in 'GhcStaticAndDynamic' mode
ghcOptDynObjSuffix :: Flag String, -- ^ only in 'GhcStaticAndDynamic' mode
ghcOptHiDir :: Flag FilePath,
ghcOptObjDir :: Flag FilePath,
ghcOptOutputDir :: Flag FilePath,
ghcOptStubDir :: Flag FilePath,
--------------------
-- Dynamic linking
ghcOptDynLinkMode :: Flag GhcDynLinkMode,
ghcOptShared :: Flag Bool,
ghcOptFPic :: Flag Bool,
ghcOptDylibName :: Flag String,
ghcOptRPaths :: NubListR FilePath,
---------------
-- 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)
data GhcDynLinkMode = GhcStaticOnly -- ^ @-static@
| GhcDynamicOnly -- ^ @-dynamic@
| GhcStaticAndDynamic -- ^ @-static -dynamic-too@
deriving (Show, Eq)
runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> GhcOptions -> IO ()
runGHC verbosity ghcProg comp opts = do
runProgramInvocation verbosity (ghcInvocation ghcProg comp opts)
ghcInvocation :: ConfiguredProgram -> Compiler -> GhcOptions -> ProgramInvocation
ghcInvocation prog comp opts =
programInvocation prog (renderGhcOptions comp opts)
renderGhcOptions :: Compiler -> GhcOptions -> [String]
renderGhcOptions comp opts
| compilerFlavor comp `notElem` [GHC, GHCJS] =
error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ "compiler flavor must be 'GHC' or 'GHCJS'!"
| otherwise =
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
, flagBuildingCabalPkg implInfo ]
----------------
-- Compilation
, case flagToMaybe (ghcOptOptimisation opts) of
Nothing -> []
Just GhcNoOptimisation -> ["-O0"]
Just GhcNormalOptimisation -> ["-O"]
Just GhcMaximumOptimisation -> ["-O2"]
Just (GhcSpecialOptimisation s) -> ["-O" ++ s] -- eg -Odph
, [ "-g" | flagDebugInfo implInfo && flagBool ghcOptDebugInfo ]
, [ "-prof" | flagBool ghcOptProfilingMode ]
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
, case flagToMaybe (ghcOptHPCDir opts) of
Nothing -> []
Just hpcdir -> ["-fhpc", "-hpcdir", hpcdir]
, if parmakeSupported comp
then case ghcOptNumJobs opts of
NoFlag -> []
Flag n -> ["-j" ++ maybe "" show n]
else []
--------------------
-- Dynamic linking
, [ "-shared" | flagBool ghcOptShared ]
, case flagToMaybe (ghcOptDynLinkMode opts) of
Nothing -> []
Just GhcStaticOnly -> ["-static"]
Just GhcDynamicOnly -> ["-dynamic"]
Just GhcStaticAndDynamic -> ["-static", "-dynamic-too"]
, [ "-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 ]
, concat [ ["-dynosuf", suf] | suf <- flag ghcOptDynObjSuffix ]
, concat [ ["-dynhisuf",suf] | suf <- flag ghcOptDynHiSuffix ]
, concat [ ["-outputdir", dir] | dir <- flag ghcOptOutputDir
, flagOutputDir implInfo ]
, concat [ ["-odir", dir] | dir <- flag ghcOptObjDir ]
, concat [ ["-hidir", dir] | dir <- flag ghcOptHiDir ]
, concat [ ["-stubdir", dir] | dir <- flag ghcOptStubDir
, flagStubdir implInfo ]
-----------------------
-- 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, flagFfiIncludes implInfo ]
, [ "-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 ]
, [ "-no-hs-main" | flagBool ghcOptLinkNoHsMain ]
, [ "-dynload deploy" | not (null (flags ghcOptRPaths)) ]
, concat [ [ "-optl-Wl,-rpath," ++ dir]
| dir <- flags ghcOptRPaths ]
-------------
-- Packages
, concat [ [if packageKeySupported comp
then "-this-package-key"
else "-package-name", display pkgid]
| pkgid <- flag ghcOptPackageKey ]
, [ "-hide-all-packages" | flagBool ghcOptHideAllPackages ]
, [ "-no-auto-link-packages" | flagBool ghcOptNoAutoLinkPackages ]
, packageDbArgs implInfo (ghcOptPackageDBs opts)
, if null (ghcOptSigOf opts)
then []
else "-sig-of"
: intercalate "," (map (\(n,(p,m)) -> display n ++ " is "
++ display p ++ ":"
++ display m)
(ghcOptSigOf opts))
: []
, concat $ if flagPackageId implInfo
then let space "" = ""
space xs = ' ' : xs
in [ ["-package-id", display ipkgid ++ space (display rns)]
| (ipkgid,_,rns) <- flags ghcOptPackages ]
else [ ["-package", display pkgid]
| (_,pkgid,_) <- flags ghcOptPackages ]
----------------------------
-- Language and extensions
, if supportsHaskell2010 implInfo
then [ "-X" ++ display lang | lang <- flag ghcOptLanguage ]
else []
, [ case M.lookup ext (ghcOptExtensionMap opts) of
Just arg -> arg
Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ display ext ++ " not present in ghcOptExtensionMap."
| ext <- flags ghcOptExtensions ]
----------------
-- GHCi
, concat [ [ "-ghci-script", script ] | script <- flags ghcOptGHCiScripts
, flagGhciScript implInfo ]
---------------
-- Inputs
, [ display modu | modu <- flags ghcOptInputModules ]
, flags ghcOptInputFiles
, concat [ [ "-o", out] | out <- flag ghcOptOutputFile ]
, concat [ [ "-dyno", out] | out <- flag ghcOptOutputDynFile ]
---------------
-- Extra
, flags ghcOptExtra
]
where
implInfo = getImplInfo comp
flag flg = flagToList (flg opts)
flags flg = fromNubListR . flg $ opts
flagBool flg = fromFlagOrDefault False (flg opts)
verbosityOpts :: Verbosity -> [String]
verbosityOpts verbosity
| verbosity >= deafening = ["-v"]
| verbosity >= normal = []
| otherwise = ["-w", "-v0"]
packageDbArgs :: GhcImplInfo -> PackageDBStack -> [String]
packageDbArgs implInfo dbstack = 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
packageDbFlag
| flagPackageConf implInfo
= "package-conf"
| otherwise
= "package-db"
-- -----------------------------------------------------------------------------
-- Boilerplate Monoid instance for GhcOptions
instance Monoid GhcOptions where
mempty = GhcOptions {
ghcOptMode = mempty,
ghcOptExtra = mempty,
ghcOptExtraDefault = mempty,
ghcOptInputFiles = mempty,
ghcOptInputModules = mempty,
ghcOptOutputFile = mempty,
ghcOptOutputDynFile = mempty,
ghcOptSourcePathClear = mempty,
ghcOptSourcePath = mempty,
ghcOptPackageKey = mempty,
ghcOptPackageDBs = mempty,
ghcOptPackages = mempty,
ghcOptHideAllPackages = mempty,
ghcOptNoAutoLinkPackages = mempty,
ghcOptSigOf = mempty,
ghcOptLinkLibs = mempty,
ghcOptLinkLibPath = mempty,
ghcOptLinkOptions = mempty,
ghcOptLinkFrameworks = mempty,
ghcOptNoLink = mempty,
ghcOptLinkNoHsMain = mempty,
ghcOptCcOptions = mempty,
ghcOptCppOptions = mempty,
ghcOptCppIncludePath = mempty,
ghcOptCppIncludes = mempty,
ghcOptFfiIncludes = mempty,
ghcOptLanguage = mempty,
ghcOptExtensions = mempty,
ghcOptExtensionMap = mempty,
ghcOptOptimisation = mempty,
ghcOptDebugInfo = mempty,
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
ghcOptHPCDir = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
ghcOptDynHiSuffix = mempty,
ghcOptDynObjSuffix = mempty,
ghcOptHiDir = mempty,
ghcOptObjDir = mempty,
ghcOptOutputDir = mempty,
ghcOptStubDir = mempty,
ghcOptDynLinkMode = mempty,
ghcOptShared = mempty,
ghcOptFPic = mempty,
ghcOptDylibName = mempty,
ghcOptRPaths = 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,
ghcOptOutputDynFile = combine ghcOptOutputDynFile,
ghcOptSourcePathClear = combine ghcOptSourcePathClear,
ghcOptSourcePath = combine ghcOptSourcePath,
ghcOptPackageKey = combine ghcOptPackageKey,
ghcOptPackageDBs = combine ghcOptPackageDBs,
ghcOptPackages = combine ghcOptPackages,
ghcOptHideAllPackages = combine ghcOptHideAllPackages,
ghcOptNoAutoLinkPackages = combine ghcOptNoAutoLinkPackages,
ghcOptSigOf = combine ghcOptSigOf,
ghcOptLinkLibs = combine ghcOptLinkLibs,
ghcOptLinkLibPath = combine ghcOptLinkLibPath,
ghcOptLinkOptions = combine ghcOptLinkOptions,
ghcOptLinkFrameworks = combine ghcOptLinkFrameworks,
ghcOptNoLink = combine ghcOptNoLink,
ghcOptLinkNoHsMain = combine ghcOptLinkNoHsMain,
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,
ghcOptDebugInfo = combine ghcOptDebugInfo,
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
ghcOptNumJobs = combine ghcOptNumJobs,
ghcOptHPCDir = combine ghcOptHPCDir,
ghcOptGHCiScripts = combine ghcOptGHCiScripts,
ghcOptHiSuffix = combine ghcOptHiSuffix,
ghcOptObjSuffix = combine ghcOptObjSuffix,
ghcOptDynHiSuffix = combine ghcOptDynHiSuffix,
ghcOptDynObjSuffix = combine ghcOptDynObjSuffix,
ghcOptHiDir = combine ghcOptHiDir,
ghcOptObjDir = combine ghcOptObjDir,
ghcOptOutputDir = combine ghcOptOutputDir,
ghcOptStubDir = combine ghcOptStubDir,
ghcOptDynLinkMode = combine ghcOptDynLinkMode,
ghcOptShared = combine ghcOptShared,
ghcOptFPic = combine ghcOptFPic,
ghcOptDylibName = combine ghcOptDylibName,
ghcOptRPaths = combine ghcOptRPaths,
ghcOptVerbosity = combine ghcOptVerbosity,
ghcOptCabal = combine ghcOptCabal
}
where
combine field = field a `mappend` field b