Rules.hs 3.21 KB
Newer Older
Zhen Zhang's avatar
Zhen Zhang committed
1
module Rules (topLevelTargets, buildLib, buildRules) where
2

3
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
4
import Context
Andrey Mokhov's avatar
Andrey Mokhov committed
5
import Expression
Andrey Mokhov's avatar
Andrey Mokhov committed
6
import Flavour
7
import GHC
8
9
10
11
12
13
14
15
16
17
18
19
20
import qualified Rules.Compile
import qualified Rules.Data
import qualified Rules.Dependencies
import qualified Rules.Documentation
import qualified Rules.Generate
import qualified Rules.Cabal
import qualified Rules.Configure
import qualified Rules.Gmp
import qualified Rules.Libffi
import qualified Rules.Library
import qualified Rules.Perl
import qualified Rules.Program
import qualified Rules.Register
Andrey Mokhov's avatar
Andrey Mokhov committed
21
import Settings
22
import Settings.Path
23

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

Andrey Mokhov's avatar
Andrey Mokhov committed
27
-- | This rule 'need' all top-level build targets.
28
29
topLevelTargets :: Rules ()
topLevelTargets = do
30
    want $ Rules.Generate.inplaceLibCopyTargets
31

Andrey Mokhov's avatar
Andrey Mokhov committed
32
    forM_ allStages $ \stage ->
Zhen Zhang's avatar
Zhen Zhang committed
33
34
35
36
37
38
39
40
41
        forM_ (knownPackages \\ [rts, libffi]) $ \pkg -> action (buildLib stage pkg)

buildLib :: Stage -> Package -> Action ()
buildLib stage pkg = do
    let context = vanillaContext stage pkg
    activePackages <- interpretInContext context getPackages
    when (pkg `elem` activePackages) $
        if isLibrary pkg
        then do -- build a library
42
43
            when (nonCabalContext context) $
                need [pkgSetupConfigFile context]
Zhen Zhang's avatar
Zhen Zhang committed
44
45
46
47
48
49
            ways <- interpretInContext context getLibraryWays
            libs <- mapM (pkgLibraryFile . Context stage pkg) ways
            docs <- interpretInContext context $ buildHaddock flavour
            need $ libs ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
        else -- otherwise build a program
            need =<< maybeToList <$> programPath (programContext stage pkg)
quchen's avatar
quchen committed
50

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

Andrey Mokhov's avatar
Andrey Mokhov committed
61
62
    let contexts        = liftM3 Context        allStages knownPackages allWays
        vanillaContexts = liftM2 vanillaContext allStages knownPackages
Andrey Mokhov's avatar
Andrey Mokhov committed
63
        programContexts = liftM2 programContext allStages knownPackages
64

Andrey Mokhov's avatar
Andrey Mokhov committed
65
    forM_ contexts $ mconcat
66
67
        [ Rules.Compile.compilePackage readPackageDb
        , Rules.Library.buildPackageLibrary ]
68

Zhen Zhang's avatar
Zhen Zhang committed
69
70
71
72
    let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]

    forM_ dynamicContexts Rules.Library.buildDynamicLib

Andrey Mokhov's avatar
Andrey Mokhov committed
73
74
    forM_ programContexts $ Rules.Program.buildProgram readPackageDb

Andrey Mokhov's avatar
Andrey Mokhov committed
75
    forM_ vanillaContexts $ mconcat
76
77
78
79
80
81
        [ Rules.Data.buildPackageData
        , Rules.Dependencies.buildPackageDependencies readPackageDb
        , Rules.Documentation.buildPackageDocumentation
        , Rules.Library.buildPackageGhciLibrary
        , Rules.Generate.generatePackageCode
        , Rules.Register.registerPackage writePackageDb ]
82
83

buildRules :: Rules ()
84
buildRules = do
85
86
87
88
89
90
    Rules.Cabal.cabalRules
    Rules.Configure.configureRules
    Rules.Generate.copyRules
    Rules.Generate.generateRules
    Rules.Gmp.gmpRules
    Rules.Libffi.libffiRules
Andrey Mokhov's avatar
Andrey Mokhov committed
91
    packageRules
92
    Rules.Perl.perlScriptRules