Skip to content

GitLab

Commit 4c7b7f83 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #1536 from 23Skidoo/ghc-parmake 

Initial support for parallel 'ghc --make'
parents 6a79280a f0cc4cb5
Hide whitespace changes
Inline Side-by-side
Cabal/Distribution/Simple/Build.hs
View file @ 4c7b7f83
......@@ -77,7 +77,7 @@ import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.Simple.Setup
( BuildFlags(..), ReplFlags(..), fromFlag )
( Flag(..), BuildFlags(..), ReplFlags(..), fromFlag )
import Distribution.Simple.BuildTarget
( BuildTarget(..), readBuildTargets )
import Distribution.Simple.PreProcess
......@@ -151,7 +151,8 @@ build pkg_descr lbi flags suffixes = do
withPrograms = progs',
withPackageDB = withPackageDB lbi ++ [internalPackageDB]
}
in buildComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
in buildComponent verbosity (buildNumJobs flags) pkg_descr
lbi' suffixes comp clbi distPref
repl :: PackageDescription -- ^ Mostly information from the .cabal file
......@@ -190,7 +191,8 @@ repl pkg_descr lbi flags suffixes args = do
sequence_
[ let comp = getComponent pkg_descr cname
lbi' = lbiForComponent comp lbi
in buildComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
in buildComponent verbosity NoFlag
pkg_descr lbi' suffixes comp clbi distPref
| (cname, clbi) <- init componentsToBuild ]
-- repl for target components
......@@ -201,6 +203,7 @@ repl pkg_descr lbi flags suffixes args = do
buildComponent :: Verbosity
-> Flag (Maybe Int)
-> PackageDescription
-> LocalBuildInfo
-> [PPSuffixHandler]
......@@ -208,11 +211,11 @@ buildComponent :: Verbosity
-> ComponentLocalBuildInfo
-> FilePath
-> IO ()
buildComponent verbosity pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CLib lib) clbi distPref = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity "Building library..."
buildLib verbosity pkg_descr lbi lib clbi
buildLib verbosity numJobs pkg_descr lbi lib clbi
-- Register the library in-place, so exes can depend
-- on internally defined libraries.
......@@ -228,23 +231,23 @@ buildComponent verbosity pkg_descr lbi suffixes
(withPackageDB lbi)
buildComponent verbosity pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building executable " ++ exeName exe ++ "..."
buildExe verbosity pkg_descr lbi exe clbi
buildExe verbosity numJobs pkg_descr lbi exe clbi
buildComponent verbosity pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CTest test@TestSuite { testInterface = TestSuiteExeV10{} })
clbi _distPref = do
let exe = testSuiteExeV10AsExe test
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building test suite " ++ testName test ++ "..."
buildExe verbosity pkg_descr lbi exe clbi
buildExe verbosity numJobs pkg_descr lbi exe clbi
buildComponent verbosity pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CTest
test@TestSuite { testInterface = TestSuiteLibV09{} })
clbi -- This ComponentLocalBuildInfo corresponds to a detailed
......@@ -258,27 +261,27 @@ buildComponent verbosity pkg_descr lbi suffixes
testSuiteLibV09AsLibAndExe pkg_descr lbi test clbi distPref pwd
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building test suite " ++ testName test ++ "..."
buildLib verbosity pkg lbi lib libClbi
buildLib verbosity numJobs pkg lbi lib libClbi
registerPackage verbosity ipi pkg lbi True $ withPackageDB lbi
buildExe verbosity pkg_descr lbi exe exeClbi
buildExe verbosity numJobs pkg_descr lbi exe exeClbi
buildComponent _ _ _ _
buildComponent _ _ _ _ _
(CTest TestSuite { testInterface = TestSuiteUnsupported tt })
_ _ =
die $ "No support for building test suite type " ++ display tt
buildComponent verbosity pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CBench bm@Benchmark { benchmarkInterface = BenchmarkExeV10 {} })
clbi _ = do
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
preprocessComponent pkg_descr comp lbi False verbosity suffixes
info verbosity $ "Building benchmark " ++ benchmarkName bm ++ "..."
buildExe verbosity pkg_descr lbi exe exeClbi
buildExe verbosity numJobs pkg_descr lbi exe exeClbi
buildComponent _ _ _ _
buildComponent _ _ _ _ _
(CBench Benchmark { benchmarkInterface = BenchmarkUnsupported tt })
_ _ =
die $ "No support for building benchmark type " ++ display tt
......@@ -461,29 +464,31 @@ addInternalBuildTools pkg lbi bi progs =
-- TODO: build separate libs in separate dirs so that we can build
-- multiple libs, e.g. for 'LibTest' library-style testsuites
buildLib :: Verbosity -> PackageDescription -> LocalBuildInfo
buildLib :: Verbosity -> Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib verbosity pkg_descr lbi lib clbi =
buildLib verbosity numJobs pkg_descr lbi lib clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.buildLib verbosity pkg_descr lbi lib clbi
JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi
LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi
Hugs -> Hugs.buildLib verbosity pkg_descr lbi lib clbi
NHC -> NHC.buildLib verbosity pkg_descr lbi lib clbi
UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
GHC -> GHC.buildLib verbosity numJobs pkg_descr lbi lib clbi
JHC -> JHC.buildLib verbosity pkg_descr lbi lib clbi
LHC -> LHC.buildLib verbosity pkg_descr lbi lib clbi
Hugs -> Hugs.buildLib verbosity pkg_descr lbi lib clbi
NHC -> NHC.buildLib verbosity pkg_descr lbi lib clbi
UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
HaskellSuite {} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
_ -> die "Building is not supported with this compiler."
buildExe :: Verbosity -> PackageDescription -> LocalBuildInfo
buildExe :: Verbosity -> Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe verbosity pkg_descr lbi exe clbi =
buildExe verbosity numJobs pkg_descr lbi exe clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.buildExe verbosity pkg_descr lbi exe clbi
JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi
LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi
Hugs -> Hugs.buildExe verbosity pkg_descr lbi exe clbi
NHC -> NHC.buildExe verbosity pkg_descr lbi exe clbi
UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi
JHC -> JHC.buildExe verbosity pkg_descr lbi exe clbi
LHC -> LHC.buildExe verbosity pkg_descr lbi exe clbi
Hugs -> Hugs.buildExe verbosity pkg_descr lbi exe clbi
NHC -> NHC.buildExe verbosity pkg_descr lbi exe clbi
UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
_ -> die "Building is not supported with this compiler."
......@@ -491,14 +496,16 @@ replLib :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
replLib verbosity pkg_descr lbi lib clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.replLib verbosity pkg_descr lbi lib clbi
-- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass
-- NoFlag as the numJobs parameter.
GHC -> GHC.replLib verbosity NoFlag pkg_descr lbi lib clbi
_ -> die "A REPL is not supported for this compiler."
replExe :: Verbosity -> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
replExe verbosity pkg_descr lbi exe clbi =
case compilerFlavor (compiler lbi) of
GHC -> GHC.replExe verbosity pkg_descr lbi exe clbi
GHC -> GHC.replExe verbosity NoFlag pkg_descr lbi exe clbi
_ -> die "A REPL is not supported for this compiler."
......
Cabal/Distribution/Simple/Compiler.hs
View file @ 4c7b7f83
......@@ -69,7 +69,8 @@ module Distribution.Simple.Compiler (
languageToFlags,
unsupportedLanguages,
extensionsToFlags,
unsupportedExtensions
unsupportedExtensions,
parmakeSupported
) where
import Distribution.Compiler
......@@ -79,7 +80,7 @@ import Language.Haskell.Extension (Language(Haskell98), Extension)
import Control.Monad (liftM)
import Data.List (nub)
import qualified Data.Map as M (Map)
import qualified Data.Map as M (Map, lookup)
import Data.Maybe (catMaybes, isNothing)
import System.Directory (canonicalizePath)
......@@ -214,3 +215,12 @@ extensionsToFlags comp = nub . filter (not . null)
extensionToFlag :: Compiler -> Extension -> Maybe Flag
extensionToFlag comp ext = lookup ext (compilerExtensions comp)
-- | Does this compiler support parallel --make mode?
parmakeSupported :: Compiler -> Bool
parmakeSupported comp =
case compilerFlavor comp of
GHC -> case M.lookup "Support parallel --make" (compilerProperties comp) of
Just "YES" -> True
_ -> False
_ -> False
Cabal/Distribution/Simple/GHC.hs
View file @ 4c7b7f83
......@@ -111,7 +111,10 @@ import qualified Distribution.Simple.Program.HcPkg as HcPkg
import qualified Distribution.Simple.Program.Ar as Ar
import qualified Distribution.Simple.Program.Ld as Ld
import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup (toFlag, fromFlag)
import Distribution.Simple.Setup
( toFlag, fromFlag, fromFlagOrDefault )
import qualified Distribution.Simple.Setup as Cabal
( Flag )
import Distribution.Simple.Compiler
( CompilerFlavor(..), CompilerId(..), Compiler(..), compilerVersion
, OptimisationLevel(..), PackageDB(..), PackageDBStack
......@@ -681,22 +684,23 @@ substTopDir topDir ipo
-- | Build a library with GHC.
--
buildLib, replLib :: Verbosity
buildLib, replLib :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildLib = buildOrReplLib False
replLib = buildOrReplLib True
buildOrReplLib :: Bool -> Verbosity
buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
buildOrReplLib forRepl verbosity numJobsFlag pkg_descr lbi lib clbi = do
libName <- case componentLibraries clbi of
[libName] -> return libName
[] -> die "No library name found when building library"
_ -> die "Multiple library names found when building library"
let libTargetDir = buildDir lbi
numJobs = fromMaybe 1 $ fromFlagOrDefault Nothing numJobsFlag
pkgid = packageId pkg_descr
whenVanillaLib forceVanilla =
when (not forRepl && (forceVanilla || withVanillaLib lbi))
......@@ -709,7 +713,7 @@ buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
ghcVersion = compilerVersion comp
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg
let runGhcProg = runGHC verbosity ghcProg comp
libBi <- hackThreadedFlag verbosity
comp (withProfLib lbi) (libBuildInfo lib)
......@@ -728,6 +732,7 @@ buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
baseOpts = componentGhcOptions verbosity lbi libBi clbi libTargetDir
vanillaOpts = baseOpts `mappend` mempty {
ghcOptMode = toFlag GhcModeMake,
ghcOptNumJobs = toFlag numJobs,
ghcOptPackageName = toFlag pkgid,
ghcOptInputModules = libModules lib
}
......@@ -755,7 +760,8 @@ buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
}
replOpts = vanillaOpts {
ghcOptExtra = filterGhciFlags
(ghcOptExtra vanillaOpts)
(ghcOptExtra vanillaOpts),
ghcOptNumJobs = mempty
}
`mappend` linkerOpts
`mappend` mempty {
......@@ -920,21 +926,23 @@ buildOrReplLib forRepl verbosity pkg_descr lbi lib clbi = do
-- | Build an executable with GHC.
--
buildExe, replExe :: Verbosity
buildExe, replExe :: Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildExe = buildOrReplExe False
replExe = buildOrReplExe True
buildOrReplExe :: Bool -> Verbosity
buildOrReplExe :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Executable -> ComponentLocalBuildInfo -> IO ()
buildOrReplExe forRepl verbosity _pkg_descr lbi
buildOrReplExe forRepl verbosity numJobsFlag _pkg_descr lbi
exe@Executable { exeName = exeName', modulePath = modPath } clbi = do
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
let runGhcProg = runGHC verbosity ghcProg
comp = compiler lbi
let comp = compiler lbi
numJobs = fromMaybe 1 $
fromFlagOrDefault Nothing numJobsFlag
runGhcProg = runGHC verbosity ghcProg comp
exeBi <- hackThreadedFlag verbosity
comp (withProfExe lbi) (buildInfo exe)
......@@ -1042,10 +1050,12 @@ buildOrReplExe forRepl verbosity _pkg_descr lbi
-- Build static/dynamic object files for TH, if needed.
when compileForTH $
runGhcProg compileTHOpts { ghcOptNoLink = toFlag True }
runGhcProg compileTHOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = toFlag numJobs }
unless forRepl $
runGhcProg compileOpts { ghcOptNoLink = toFlag True }
runGhcProg compileOpts { ghcOptNoLink = toFlag True
, ghcOptNumJobs = toFlag numJobs }
-- build any C sources
unless (null cSrcs) $ do
......@@ -1134,6 +1144,7 @@ libAbiHash verbosity pkg_descr lbi lib clbi = do
libBi <- hackThreadedFlag verbosity
(compiler lbi) (withProfLib lbi) (libBuildInfo lib)
let
comp = compiler lbi
vanillaArgs =
(componentGhcOptions verbosity lbi libBi clbi (buildDir lbi))
`mappend` mempty {
......@@ -1160,7 +1171,7 @@ libAbiHash verbosity pkg_descr lbi lib clbi = do
else error "libAbiHash: Can't find an enabled library way"
--
(ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)
getProgramInvocationOutput verbosity (ghcInvocation ghcProg ghcArgs)
getProgramInvocationOutput verbosity (ghcInvocation ghcProg comp ghcArgs)
componentGhcOptions :: Verbosity -> LocalBuildInfo
......
Cabal/Distribution/Simple/Haddock.hs
View file @ 4c7b7f83
......@@ -194,7 +194,7 @@ haddock pkg_descr lbi suffixes flags = do
++ "GHC version.\n"
++ "The GHC version is " ++ display ghcVersion ++ " but "
++ "haddock is using GHC version " ++ display haddockGhcVersion
where ghcVersion = compilerVersion (compiler lbi)
where ghcVersion = compilerVersion comp
-- the tools match the requests, we can proceed
......@@ -210,8 +210,8 @@ haddock pkg_descr lbi suffixes flags = do
, fromPackageDescription pkg_descr ]
let pre c = preprocessComponent pkg_descr c lbi False verbosity suffixes
withAllComponentsInBuildOrder pkg_descr lbi $ \comp clbi -> do
pre comp
withAllComponentsInBuildOrder pkg_descr lbi $ \component clbi -> do
pre component
let
doExe com = case (compToExe com) of
Just exe -> do
......@@ -220,22 +220,22 @@ haddock pkg_descr lbi suffixes flags = do
exeArgs <- fromExecutable verbosity tmp lbi exe clbi htmlTemplate
exeArgs' <- prepareSources verbosity tmp
lbi version bi (commonArgs `mappend` exeArgs)
runHaddock verbosity tmpFileOpts confHaddock exeArgs'
runHaddock verbosity tmpFileOpts comp confHaddock exeArgs'
Nothing -> do
warn (fromFlag $ haddockVerbosity flags)
"Unsupported component, skipping..."
return ()
case comp of
case component of
CLib lib -> do
withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ \tmp -> do
let bi = libBuildInfo lib
libArgs <- fromLibrary verbosity tmp lbi lib clbi htmlTemplate
libArgs' <- prepareSources verbosity tmp
lbi version bi (commonArgs `mappend` libArgs)
runHaddock verbosity tmpFileOpts confHaddock libArgs'
CExe _ -> when (flag haddockExecutables) $ doExe comp
CTest _ -> when (flag haddockTestSuites) $ doExe comp
CBench _ -> when (flag haddockBenchmarks) $ doExe comp
runHaddock verbosity tmpFileOpts comp confHaddock libArgs'
CExe _ -> when (flag haddockExecutables) $ doExe component
CTest _ -> when (flag haddockTestSuites) $ doExe component
CBench _ -> when (flag haddockBenchmarks) $ doExe component
forM_ (extraDocFiles pkg_descr) $ \ fpath -> do
files <- matchFileGlob fpath
......@@ -243,6 +243,7 @@ haddock pkg_descr lbi suffixes flags = do
where
verbosity = flag haddockVerbosity
keepTempFiles = flag haddockKeepTempFiles
comp = compiler lbi
tmpFileOpts = defaultTempFileOptions { optKeepTempFiles = keepTempFiles }
flag f = fromFlag $ f flags
htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags
......@@ -450,13 +451,15 @@ getGhcLibDir verbosity lbi isVersion2
-- | Call haddock with the specified arguments.
runHaddock :: Verbosity
-> TempFileOptions
-> Compiler
-> ConfiguredProgram
-> HaddockArgs
-> IO ()
runHaddock verbosity tmpFileOpts confHaddock args = do
runHaddock verbosity tmpFileOpts comp confHaddock args = do
let haddockVersion = fromMaybe (error "unable to determine haddock version")
(programVersion confHaddock)
renderArgs verbosity tmpFileOpts haddockVersion args $ \(flags,result)-> do
renderArgs verbosity tmpFileOpts haddockVersion comp args $
\(flags,result)-> do
rawSystemProgram verbosity confHaddock flags
......@@ -466,17 +469,18 @@ runHaddock verbosity tmpFileOpts confHaddock args = do
renderArgs :: Verbosity
-> TempFileOptions
-> Version
-> Compiler
-> HaddockArgs
-> (([String], FilePath) -> IO a)
-> IO a
renderArgs verbosity tmpFileOpts version args k = do
renderArgs verbosity tmpFileOpts version comp args k = do
createDirectoryIfMissingVerbose verbosity True outputDir
withTempFileEx tmpFileOpts outputDir "haddock-prolog.txt" $ \prologFileName h -> do
do
hPutStrLn h $ fromFlag $ argPrologue args
hClose h
let pflag = "--prologue=" ++ prologFileName
k (pflag : renderPureArgs version args, result)
k (pflag : renderPureArgs version comp args, result)
where
isVersion2 = version >= Version [2,0] []
outputDir = (unDir $ argOutputDir args)
......@@ -492,8 +496,8 @@ renderArgs verbosity tmpFileOpts version args k = do
pkgid = arg argPackageName
arg f = fromFlag $ f args
renderPureArgs :: Version -> HaddockArgs -> [String]
renderPureArgs version args = concat
renderPureArgs :: Version -> Compiler -> HaddockArgs -> [String]
renderPureArgs version comp args = concat
[
(:[]) . (\f -> "--dump-interface="++ unDir (argOutputDir args) </> f)
. fromFlag . argInterfaceFile $ args,
......@@ -513,8 +517,8 @@ renderPureArgs version args = concat
(:[]).("--title="++) . (bool (++" (internal documentation)") id (getAny $ argIgnoreExports args))
. fromFlag . argTitle $ args,
[ "--optghc=" ++ opt | isVersion2
, (opts, ghcVersion) <- flagToList (argGhcOptions args)
, opt <- renderGhcOptions ghcVersion opts ],
, (opts, _ghcVer) <- flagToList (argGhcOptions args)
, opt <- renderGhcOptions comp opts ],
maybe [] (\l -> ["-B"++l]) $ guard isVersion2 >> flagToMaybe (argGhcLibDir args), -- error if isVersion2 and Nothing?
argTargets $ args
]
......
Cabal/Distribution/Simple/Program/GHC.hs
View file @ 4c7b7f83
......@@ -14,18 +14,18 @@ module Distribution.Simple.Program.GHC (
import Distribution.Package
import Distribution.ModuleName
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.Setup (Flag(..), flagToMaybe, fromFlagOrDefault, flagToList)
import Distribution.Simple.Setup ( Flag(..), flagToMaybe, fromFlagOrDefault,
flagToList )
--import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Run
import Distribution.Text
import Distribution.Verbosity
import Distribution.Version
import Language.Haskell.Extension ( Language(..), Extension(..) )
import Language.Haskell.Extension ( Language(..), Extension(..) )
import Data.Monoid
-- | A structured set of GHC options/flags
--
data GhcOptions = GhcOptions {
......@@ -148,6 +148,9 @@ data GhcOptions = GhcOptions {
-- | Use the \"split object files\" feature; the @ghc -split-objs@ flag.
ghcOptSplitObjs :: Flag Bool,
-- | Run N jobs simultaneously (if possible).
ghcOptNumJobs :: Flag Int,
----------------
-- GHCi
......@@ -208,20 +211,22 @@ data GhcDynLinkMode = GhcStaticOnly -- ^ @-static@
deriving (Show, Eq)
runGHC :: Verbosity -> ConfiguredProgram -> GhcOptions -> IO ()
runGHC verbosity ghcProg opts = do
runProgramInvocation verbosity (ghcInvocation ghcProg opts)
runGHC :: Verbosity -> ConfiguredProgram -> Compiler -> GhcOptions -> IO ()
runGHC verbosity ghcProg comp opts = do
runProgramInvocation verbosity (ghcInvocation ghcProg comp opts)
ghcInvocation :: ConfiguredProgram -> GhcOptions -> ProgramInvocation
ghcInvocation ConfiguredProgram { programVersion = Nothing } _ =
error "ghcInvocation: the programVersion must not be Nothing"
ghcInvocation prog@ConfiguredProgram { programVersion = Just ver } opts =
programInvocation prog (renderGhcOptions ver opts)
ghcInvocation :: ConfiguredProgram -> Compiler -> GhcOptions -> ProgramInvocation
ghcInvocation prog comp opts =
programInvocation prog (renderGhcOptions comp opts)
renderGhcOptions :: Version -> GhcOptions -> [String]
renderGhcOptions version@(Version ver _) opts =
renderGhcOptions :: Compiler -> GhcOptions -> [String]
renderGhcOptions comp opts
| compilerFlavor comp /= GHC =
error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ "compiler flavor must be 'GHC'!"
| otherwise =
concat
[ case flagToMaybe (ghcOptMode opts) of
Nothing -> []
......@@ -258,6 +263,13 @@ renderGhcOptions version@(Version ver _) opts =
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
, if parmakeSupported comp
then
let numJobs = fromFlagOrDefault 1 (ghcOptNumJobs opts)
in if numJobs > 1 then ["-j" ++ show numJobs] else []
else []
--------------------
-- Dynamic linking
......@@ -330,8 +342,8 @@ renderGhcOptions version@(Version ver _) opts =
, [ case lookup ext (ghcOptExtensionMap opts) of
Just arg -> arg
Nothing -> error $ "renderGhcOptions: " ++ display ext
++ " not present in ghcOptExtensionMap."
Nothing -> error $ "Distribution.Simple.Program.GHC.renderGhcOptions: "
++ display ext ++ " not present in ghcOptExtensionMap."
| ext <- ghcOptExtensions opts ]
----------------
......@@ -362,6 +374,7 @@ renderGhcOptions version@(Version ver _) opts =
flags flg = flg opts
flagBool flg = fromFlagOrDefault False (flg opts)
version@(Version ver _) = compilerVersion comp
verbosityOpts :: Verbosity -> [String]
verbosityOpts verbosity
......@@ -425,6 +438,7 @@ instance Monoid GhcOptions where
ghcOptOptimisation = mempty,
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
......@@ -473,6 +487,7 @@ instance Monoid GhcOptions where
ghcOptOptimisation = combine ghcOptOptimisation,
ghcOptProfilingMode = combine ghcOptProfilingMode,
ghcOptSplitObjs = combine ghcOptSplitObjs,
ghcOptNumJobs = combine ghcOptNumJobs,
ghcOptGHCiScripts = combine ghcOptGHCiScripts,
ghcOptHiSuffix = combine ghcOptHiSuffix,
ghcOptObjSuffix = combine ghcOptObjSuffix,
......
Cabal/Distribution/Simple/Setup.hs
View file @ 4c7b7f83
......@@ -89,7 +89,7 @@ module Distribution.Simple.Setup (
fromFlagOrDefault,
flagToMaybe,
flagToList,
boolOpt, boolOpt', trueArg, falseArg, optionVerbosity ) where
boolOpt, boolOpt', trueArg, falseArg, optionVerbosity, numJobsParser ) where
import Distribution.Compiler ()
import Distribution.ReadE
......@@ -1356,6 +1356,7 @@ data BuildFlags = BuildFlags {
buildProgramArgs :: [(String, [String])],
buildDistPref :: Flag FilePath,
buildVerbosity :: Flag Verbosity,
buildNumJobs :: Flag (Maybe Int),
-- TODO: this one should not be here, it's just that the silly
-- UserHooks stop us from passing extra info in other ways
buildArgs :: [String]
......@@ -1372,6 +1373,7 @@ defaultBuildFlags = BuildFlags {
buildProgramArgs = [],
buildDistPref = Flag defaultDistPref,
buildVerbosity = Flag normal,
buildNumJobs = mempty,
buildArgs = []
}
......@@ -1405,6 +1407,13 @@ buildOptions progConf showOrParseArgs =
buildDistPref (\d flags -> flags { buildDistPref = d })
showOrParseArgs
: option "j" ["jobs"]
"Run NUM jobs simultaneously (or '$ncpus' if no NUM is given)"
buildNumJobs (\v flags -> flags { buildNumJobs = v })
(optArg "NUM" (fmap Flag numJobsParser)
(Flag Nothing)
(map (Just . maybe "$ncpus" show) . flagToList))
: programConfigurationPaths progConf showOrParseArgs
buildProgramPaths (\v flags -> flags { buildProgramPaths = v})
......@@ -1423,6 +1432,7 @@ instance Monoid BuildFlags where
buildProgramArgs = mempty,
buildVerbosity = mempty,
buildDistPref = mempty,
buildNumJobs = mempty,
buildArgs = mempty
}
mappend a b = BuildFlags {
......@@ -1430,6 +1440,7 @@ instance Monoid BuildFlags where
buildProgramArgs = combine buildProgramArgs,
buildVerbosity = combine buildVerbosity,