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

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

import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
6
import Context
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
import Rules.Compile
import Rules.Data
import Rules.Dependencies
import Rules.Documentation
import Rules.Generate
import Rules.Cabal
15
import Rules.Configure
Andrey Mokhov's avatar
Andrey Mokhov committed
16
17
18
19
20
21
import Rules.Gmp
import Rules.Libffi
import Rules.Library
import Rules.Perl
import Rules.Program
import Rules.Register
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
Andrey Mokhov's avatar
Andrey Mokhov committed
36
37
        rtsLib    <- pkgLibraryFile $ rtsContext { way = vanilla  }
        rtsThrLib <- pkgLibraryFile $ rtsContext { way = 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
                    ways <- interpretInContext context getLibraryWays
Andrey Mokhov's avatar
Andrey Mokhov committed
48
                    libs <- traverse (pkgLibraryFile . Context stage pkg) ways
49
                    docs <- interpretInContext context buildHaddock
Andrey Mokhov's avatar
Andrey Mokhov committed
50
                    need $ libs ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
51
                else do -- otherwise build a program
Andrey Mokhov's avatar
Andrey Mokhov committed
52
                    need [ fromJust $ programPath context ] -- 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
    -- TODO: not all build rules make sense for all stage/package combinations
Andrey Mokhov's avatar
Andrey Mokhov committed
65
66
    let contexts        = liftM3 Context        allStages knownPackages allWays
        vanillaContexts = liftM2 vanillaContext allStages knownPackages
67

68
69
70
71
72
73
74
75
    for_ contexts $ mconcat
        [ compilePackage readPackageDb
        , buildPackageLibrary ]

    for_ vanillaContexts $ mconcat
        [ buildPackageData
        , buildPackageDependencies readPackageDb
        , buildPackageDocumentation
76
        , buildPackageGhciLibrary
77
        , generatePackageCode
78
        , buildProgram readPackageDb
79
        , registerPackage writePackageDb ]
80
81

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