Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
4c7b7f83
Commit
4c7b7f83
authored
Oct 31, 2013
by
Mikhail Glushenkov
Browse files
Merge pull request #1536 from 23Skidoo/ghc-parmake
Initial support for parallel 'ghc --make'
parents
6a79280a
f0cc4cb5
Changes
13
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
(
comp
iler
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
$
\
comp
onent
clbi
->
do
pre
comp
onent
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
comp
onent
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
comp
onent
CTest
_
->
when
(
flag
haddockTestSuites
)
$
doExe
comp
onent
CBench
_
->
when
(
flag
haddockBenchmarks
)
$
doExe
comp
onent
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
,
ghcVer
sion
)
<-
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