1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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
105
106
107
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
|
module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where
import qualified Hadrian.Oracles.ArgsHash
import qualified Hadrian.Oracles.DirectoryContents
import qualified Hadrian.Oracles.Path
import qualified Hadrian.Oracles.TextFile
import Expression
import GHC
import qualified Oracles.ModuleFiles
import qualified Rules.BinaryDist
import qualified Rules.Compile
import qualified Rules.Configure
import qualified Rules.Dependencies
import qualified Rules.Documentation
import qualified Rules.Generate
import qualified Rules.Gmp
import qualified Rules.Libffi
import qualified Rules.Library
import qualified Rules.PackageData
import qualified Rules.Program
import qualified Rules.Register
import Settings
import Target
import Utilities
allStages :: [Stage]
allStages = [minBound .. maxBound]
-- | This rule calls 'need' on all top-level build targets, respecting the
-- 'Stage1Only' flag.
topLevelTargets :: Rules ()
topLevelTargets = action $ do
(programs, libraries) <- partition isProgram <$> stagePackages Stage1
pgmNames <- mapM (g Stage1) programs
libNames <- mapM (g Stage1) libraries
verbosity <- getVerbosity
when (verbosity >= Loud) $ do
putNormal "Building stage2"
putNormal . unlines $
[ "| Building Programs : " ++ intercalate ", " pgmNames
, "| Building Libraries: " ++ intercalate ", " libNames ]
targets <- mapM (f Stage1) =<< stagePackages Stage1
need targets
where
-- either the package database config file for libraries or
-- the programPath for programs. However this still does
-- not support multiple targets, where a cabal package has
-- a library /and/ a program.
f :: Stage -> Package -> Action FilePath
f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v"))
| otherwise = programPath =<< programContext stage pkg
g :: Stage -> Package -> Action String
g stage pkg | isLibrary pkg = return $ pkgName pkg
| otherwise = programName (Context stage pkg (read "v"))
-- TODO: Get rid of the @includeGhciLib@ hack.
-- | Return the list of targets associated with a given 'Stage' and 'Package'.
-- By setting the Boolean parameter to False it is possible to exclude the GHCi
-- library from the targets, and avoid running @ghc-cabal@ to determine whether
-- GHCi library needs to be built for this package. We typically want to set
-- this parameter to True, however it is important to set it to False when
-- computing 'topLevelTargets', as otherwise the whole build gets sequentialised
-- because we need to run @ghc-cabal@ in the order respecting package dependencies.
packageTargets :: Bool -> Stage -> Package -> Action [FilePath]
packageTargets includeGhciLib stage pkg = do
let context = vanillaContext stage pkg
activePackages <- stagePackages stage
if pkg `notElem` activePackages
then return [] -- Skip inactive packages.
else if isLibrary pkg
then do -- Collect all targets of a library package.
let pkgWays = if pkg == rts then getRtsWays else getLibraryWays
ways <- interpretInContext context pkgWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways
more <- libraryTargets includeGhciLib context
setup <- pkgSetupConfigFile context
return $ [ setup | not (nonCabalContext context) ] ++ libs ++ more
else do -- The only target of a program package is the executable.
prgContext <- programContext stage pkg
prgPath <- programPath prgContext
return [prgPath]
packageRules :: Rules ()
packageRules = do
-- We cannot register multiple GHC packages in parallel. Also we cannot run
-- GHC when the package database is being mutated by "ghc-pkg". This is a
-- classic concurrent read exclusive write (CREW) conflict.
let maxConcurrentReaders = 1000
packageDb <- newResource "package-db" maxConcurrentReaders
let readPackageDb = [(packageDb, 1)]
writePackageDb = [(packageDb, maxConcurrentReaders)]
let contexts = liftM3 Context allStages knownPackages allWays
vanillaContexts = liftM2 vanillaContext allStages knownPackages
-- TODO: we might want to look into converting more and more
-- rules to the style introduced in Rules.Library in
-- https://github.com/snowleopard/hadrian/pull/571,
-- where "catch-all" rules are used to "catch" the need
-- for library files, and we then use parsec parsers to
-- extract all sorts of information needed to build them, like
-- the package, the stage, the way, etc.
forM_ contexts (Rules.Compile.compilePackage readPackageDb)
Rules.Program.buildProgram readPackageDb
forM_ [Stage0 .. ] $ \stage -> do
-- we create a dummy context, that has the correct state, but contains
-- @dummyPackage@ as a... dummy package. The package isn't accessed but the record
-- need to be set properly. @undefined@ is not an option as it ends up
-- being forced.
Rules.Register.registerPackages writePackageDb (Context stage dummyPackage vanilla)
forM_ vanillaContexts $ mconcat
[ Rules.PackageData.buildPackageData
, Rules.Dependencies.buildPackageDependencies readPackageDb
, Rules.Documentation.buildPackageDocumentation
, Rules.Generate.generatePackageCode ]
buildRules :: Rules ()
buildRules = do
Rules.BinaryDist.bindistRules
Rules.Configure.configureRules
Rules.Generate.copyRules
Rules.Generate.generateRules
Rules.Gmp.gmpRules
Rules.Libffi.libffiRules
Rules.Library.libraryRules
packageRules
oracleRules :: Rules ()
oracleRules = do
Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
Hadrian.Oracles.DirectoryContents.directoryContentsOracle
Hadrian.Oracles.Path.pathOracle
Hadrian.Oracles.TextFile.textFileOracle
Oracles.ModuleFiles.moduleFilesOracle
|
