Rules.hs 2.91 KB
Newer Older
1
module Rules (topLevelTargets, buildRules) where
2

quchen's avatar
quchen committed
3
import Data.Foldable
4
5

import Base
6
import Context hiding (stage, package, way)
Andrey Mokhov's avatar
Andrey Mokhov committed
7
import Expression
8
import GHC
Andrey Mokhov's avatar
Andrey Mokhov committed
9
10
11
12
13
14
15
16
17
18
19
20
21
import Rules.Compile
import Rules.Data
import Rules.Dependencies
import Rules.Documentation
import Rules.Generate
import Rules.Cabal
import Rules.Gmp
import Rules.Libffi
import Rules.Library
import Rules.Perl
import Rules.Program
import Rules.Register
import Rules.Setup
Andrey Mokhov's avatar
Andrey Mokhov committed
22
import Settings
23

quchen's avatar
quchen committed
24
allStages :: [Stage]
quchen's avatar
quchen committed
25
allStages = [minBound ..]
quchen's avatar
quchen committed
26
27

-- | 'need' all top-level build targets
28
29
30
31
32
33
34
35
topLevelTargets :: Rules ()
topLevelTargets = do

    want $ Rules.Generate.installTargets

    -- TODO: do we want libffiLibrary to be a top-level target?

    action $ do -- TODO: Add support for all rtsWays
36
37
        rtsLib    <- pkgLibraryFile Stage1 rts vanilla
        rtsThrLib <- pkgLibraryFile Stage1 rts threaded
38
39
40
41
        need [ rtsLib, rtsThrLib ]

    for_ allStages $ \stage ->
        for_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
42
43
            let context = vanillaContext stage pkg
            activePackages <- interpretInContext context getPackages
44
45
46
            when (pkg `elem` activePackages) $
                if isLibrary pkg
                then do -- build a library
47
48
49
50
                    ways <- interpretInContext context getLibraryWays
                    libs <- traverse (pkgLibraryFile stage pkg) ways
                    docs <- interpretInContext context buildHaddock
                    need $ libs ++ [ pkgHaddockFile pkg | docs && stage == Stage1 ]
51
52
                else do -- otherwise build a program
                    need [ fromJust $ programPath stage pkg ] -- TODO: drop fromJust
quchen's avatar
quchen committed
53

54
packageRules :: Rules ()
55
packageRules = do
56
57
    -- 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
58
59
60
61
62
63
    -- classic concurrent read exclusive write (CREW) conflict.
    let maxConcurrentReaders = 1000
    packageDb <- newResource "package-db" maxConcurrentReaders
    let readPackageDb  = [(packageDb, 1)]
        writePackageDb = [(packageDb, maxConcurrentReaders)]

64
65
66
67
    let contexts = liftM3 Context allStages knownPackages allWays

    traverse_ (compilePackage readPackageDb) contexts

quchen's avatar
quchen committed
68
    for_ allStages $ \stage ->
69
70
        for_ knownPackages $ \package -> do
            let context = vanillaContext stage package
71
72
73
74
75
76
77
            buildPackageData                         context
            buildPackageDependencies  readPackageDb  context
            buildPackageDocumentation                context
            generatePackageCode                      context
            buildPackageLibrary                      context
            buildProgram                             context
            registerPackage           writePackageDb context
78
79

buildRules :: Rules ()
80
buildRules = do
Andrey Mokhov's avatar
Andrey Mokhov committed
81
82
83
84
85
86
87
88
    cabalRules
    generateRules
    copyRules
    gmpRules
    libffiRules
    perlScriptRules
    setupRules
    packageRules