Rules.hs 3.79 KB
Newer Older
Zhen Zhang's avatar
Zhen Zhang committed
1
module Rules (topLevelTargets, buildPackage, 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
Zhen Zhang's avatar
Zhen Zhang committed
21
22
import Oracles.Dependencies (needContext)
import Util (needBuilder)
Andrey Mokhov's avatar
Andrey Mokhov committed
23
import Settings
24
import Settings.Path
25

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

Zhen Zhang's avatar
Zhen Zhang committed
29
30
-- | This rule 'need' all top-level build targets
-- or Stage1Only targets
31
topLevelTargets :: Rules ()
Zhen Zhang's avatar
Zhen Zhang committed
32
33
topLevelTargets = action $ do
    need $ Rules.Generate.inplaceLibCopyTargets
34

Zhen Zhang's avatar
Zhen Zhang committed
35
36
37
38
39
40
41
42
43
44
45
46
    if stage1Only
        then do
             forAllPkgs $ \stg pkg ->
                 when (isLibrary pkg) $
                     buildPackage stg pkg
             forM_ programsStage1Only $ buildPackage Stage0
        else
             forAllPkgs buildPackage
  where
    forAllPkgs f =
      forM_ allStages $ \stage ->
          forM_ (knownPackages \\ [rts, libffi]) $ \pkg -> f stage pkg
Zhen Zhang's avatar
Zhen Zhang committed
47

Zhen Zhang's avatar
Zhen Zhang committed
48
49
buildPackage :: Stage -> Package -> Action ()
buildPackage stage pkg = do
Zhen Zhang's avatar
Zhen Zhang committed
50
51
52
53
54
    let context = vanillaContext stage pkg
    activePackages <- interpretInContext context getPackages
    when (pkg `elem` activePackages) $
        if isLibrary pkg
        then do -- build a library
55
56
            when (nonCabalContext context) $
                need [pkgSetupConfigFile context]
Zhen Zhang's avatar
Zhen Zhang committed
57
58
59
            ways <- interpretInContext context getLibraryWays
            libs <- mapM (pkgLibraryFile . Context stage pkg) ways
            docs <- interpretInContext context $ buildHaddock flavour
Zhen Zhang's avatar
Zhen Zhang committed
60
            needContext [context]
Zhen Zhang's avatar
Zhen Zhang committed
61
62
63
            need $ libs ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
        else -- otherwise build a program
            need =<< maybeToList <$> programPath (programContext stage pkg)
quchen's avatar
quchen committed
64

65
packageRules :: Rules ()
66
packageRules = do
67
68
    -- 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
69
70
71
72
73
74
    -- 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
75
76
    let contexts        = liftM3 Context        allStages knownPackages allWays
        vanillaContexts = liftM2 vanillaContext allStages knownPackages
Andrey Mokhov's avatar
Andrey Mokhov committed
77
        programContexts = liftM2 programContext allStages knownPackages
78

Andrey Mokhov's avatar
Andrey Mokhov committed
79
    forM_ contexts $ mconcat
80
81
        [ Rules.Compile.compilePackage readPackageDb
        , Rules.Library.buildPackageLibrary ]
82

Zhen Zhang's avatar
Zhen Zhang committed
83
84
85
86
    let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic]

    forM_ dynamicContexts Rules.Library.buildDynamicLib

Andrey Mokhov's avatar
Andrey Mokhov committed
87
88
    forM_ programContexts $ Rules.Program.buildProgram readPackageDb

Andrey Mokhov's avatar
Andrey Mokhov committed
89
    forM_ vanillaContexts $ mconcat
90
91
92
93
94
95
        [ Rules.Data.buildPackageData
        , Rules.Dependencies.buildPackageDependencies readPackageDb
        , Rules.Documentation.buildPackageDocumentation
        , Rules.Library.buildPackageGhciLibrary
        , Rules.Generate.generatePackageCode
        , Rules.Register.registerPackage writePackageDb ]
96
97

buildRules :: Rules ()
98
buildRules = do
99
100
101
102
103
104
    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
105
    packageRules
106
    Rules.Perl.perlScriptRules
Zhen Zhang's avatar
Zhen Zhang committed
107
108
109
110
111
112

programsStage1Only :: [Package]
programsStage1Only =
  [ deriveConstants, genprimopcode, hp2ps, runGhc
  , ghcCabal, hpc, dllSplit, ghcPkg, hsc2hs
  , genapply, ghc ]