Commit 6afd56db authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Support for '--make -j' in 'renderGhcOptions'.

parent 6a79280a
......@@ -709,7 +709,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)
......@@ -933,8 +933,8 @@ buildOrReplExe forRepl verbosity _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
runGhcProg = runGHC verbosity ghcProg comp
exeBi <- hackThreadedFlag verbosity
comp (withProfExe lbi) (buildInfo exe)
......@@ -1134,6 +1134,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 +1161,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
......
......@@ -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
]
......
......@@ -14,17 +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
import qualified Data.Map as M ( lookup )
-- | A structured set of GHC options/flags
--
......@@ -148,6 +149,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 +212,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 +264,13 @@ renderGhcOptions version@(Version ver _) opts =
, [ "-split-objs" | flagBool ghcOptSplitObjs ]
, let numJobs = fromFlagOrDefault 1 (ghcOptNumJobs opts) in
case M.lookup "Support parallel --make" (compilerProperties comp) of
Just "YES" ->
if numJobs > 1 then ["-j" ++ show numJobs] else []
_ -> []
--------------------
-- Dynamic linking
......@@ -330,8 +343,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 +375,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 +439,7 @@ instance Monoid GhcOptions where
ghcOptOptimisation = mempty,
ghcOptProfilingMode = mempty,
ghcOptSplitObjs = mempty,
ghcOptNumJobs = mempty,
ghcOptGHCiScripts = mempty,
ghcOptHiSuffix = mempty,
ghcOptObjSuffix = mempty,
......@@ -473,6 +488,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,
......
......@@ -42,7 +42,6 @@ import Distribution.Simple.Configure
import Distribution.Compiler ( buildCompilerId )
import Distribution.Simple.Compiler
( CompilerFlavor(GHC), Compiler(compilerId)
, compilerVersion
, PackageDB(..), PackageDBStack )
import Distribution.Simple.Program
( ProgramConfiguration, emptyProgramConfiguration
......@@ -430,7 +429,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do
(\cabalInstalledPkgId -> [(cabalInstalledPkgId, cabalPkgid)])
maybeCabalInstalledPkgId
}
let ghcCmdLine = renderGhcOptions (compilerVersion compiler) ghcOptions
let ghcCmdLine = renderGhcOptions compiler ghcOptions
case useLoggingHandle options of
Nothing -> runDbProgram verbosity ghcProgram conf ghcCmdLine
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment