Rules.hs 7.63 KB
Newer Older
1 2
module Rules (buildRules, oracleRules, packageTargets, topLevelTargets
             , toolArgsTarget ) where
Andrey Mokhov's avatar
Andrey Mokhov committed
3 4

import qualified Hadrian.Oracles.ArgsHash
5
import qualified Hadrian.Oracles.Cabal.Rules
Andrey Mokhov's avatar
Andrey Mokhov committed
6 7
import qualified Hadrian.Oracles.DirectoryContents
import qualified Hadrian.Oracles.Path
8
import qualified Hadrian.Oracles.TextFile
9

Andrey Mokhov's avatar
Andrey Mokhov committed
10
import Expression
11
import qualified Oracles.Flavour
Andrey Mokhov's avatar
Andrey Mokhov committed
12
import qualified Oracles.ModuleFiles
13
import Packages
14
import qualified Rules.BinaryDist
15
import qualified Rules.Compile
16
import qualified Rules.Configure
17 18 19 20 21 22 23 24
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.Program
import qualified Rules.Register
25
import qualified Rules.Rts
26
import qualified Rules.SimpleTargets
Andrey Mokhov's avatar
Andrey Mokhov committed
27
import Settings
28
import Settings.Program (programContext)
Andrey Mokhov's avatar
Andrey Mokhov committed
29
import Target
30
import UserSettings
31

32 33 34 35 36
-- | @tool-args@ is used by tooling in order to get the arguments necessary
-- to set up a GHC API session which can compile modules from GHC. When
-- run, the target prints out the arguments that would be passed to @ghc@
-- during normal compilation to @stdout@.
--
37
-- This target is called by the `ghci` script in order to load all of GHC's
38 39 40 41
-- modules into GHCi.
toolArgsTarget :: Rules ()
toolArgsTarget = do
  "tool-args" ~> do
42 43 44 45
    -- We can't build DLLs on Windows (yet). Actually we should only
    -- include the dynamic way when we have a dynamic host GHC, but just
    -- checking for Windows seems simpler for now.
    let fake_target = target (Context Stage0 compiler (if windowsHost then vanilla else dynamic))
46 47 48
                             (Ghc ToolArgs Stage0) [] ["ignored"]

    -- need the autogenerated files so that they are precompiled
49
    includesDependencies Stage0 >>= need
50 51 52 53
    interpret fake_target Rules.Generate.compilerDependencies >>= need

    root <- buildRoot
    let dir = buildDir (vanillaContext Stage0 compiler)
54 55 56
    need [ root -/- dir -/- "Config.hs" ]
    need [ root -/- dir -/- "Parser.hs" ]
    need [ root -/- dir -/- "Lexer.hs" ]
57 58
    need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Parser.hs" ]
    need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Lexer.hs"  ]
59 60 61 62

    -- Find out the arguments that are needed to load a module into the
    -- session
    arg_list <- interpret fake_target getArgs
63
    liftIO $ putStrLn (intercalate "\n" arg_list)
64

quchen's avatar
quchen committed
65
allStages :: [Stage]
66
allStages = [minBound .. maxBound]
quchen's avatar
quchen committed
67

68
-- | This rule calls 'need' on all top-level build targets that Hadrian builds
69
-- by default, respecting the 'finalStage' flag.
70
topLevelTargets :: Rules ()
Zhen Zhang's avatar
Zhen Zhang committed
71
topLevelTargets = action $ do
72
    verbosity <- getVerbosity
73 74 75 76 77 78 79 80
    forM_ [ Stage1 ..] $ \stage -> do
      when (verbosity >= Loud) $ do
        (libraries, programs) <- partition isLibrary <$> stagePackages stage
        libNames <- mapM (name stage) libraries
        pgmNames <- mapM (name stage) programs
        let stageHeader t ps =
              "| Building " ++ show stage ++ " "
                            ++ t ++ ": " ++ intercalate ", " ps
81
        putNormal . unlines $
82 83 84
            [ stageHeader "libraries" libNames
            , stageHeader "programs" pgmNames ]
    let buildStages = [ s | s <- [Stage0 ..], s < finalStage ]
85 86 87
    targets <- concatForM buildStages $ \stage -> do
        packages <- stagePackages stage
        mapM (path stage) packages
88 89 90 91 92 93

    -- Why we need wrappers: https://gitlab.haskell.org/ghc/ghc/issues/16534.
    root <- buildRoot
    let wrappers = [ root -/- ("ghc-" ++ stageString s) | s <- [Stage1 ..]
                                                        , s < finalStage ]
    need (targets ++ wrappers)
94 95 96 97 98
  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.
99 100 101 102 103 104
    path :: Stage -> Package -> Action FilePath
    path stage pkg | isLibrary pkg = pkgConfFile (vanillaContext stage pkg)
                   | otherwise     = programPath =<< programContext stage pkg
    name :: Stage -> Package -> Action String
    name stage pkg | isLibrary pkg = return (pkgName pkg)
                   | otherwise     = programName (vanillaContext stage pkg)
105

106
-- TODO: Get rid of the @includeGhciLib@ hack.
107
-- | Return the list of targets associated with a given 'Stage' and 'Package'.
108
-- By setting the Boolean parameter to False it is possible to exclude the GHCi
109 110
-- library from the targets, and avoid configuring the package to determine
-- whether GHCi library needs to be built for it. We typically want to set
111 112
-- this parameter to True, however it is important to set it to False when
-- computing 'topLevelTargets', as otherwise the whole build gets sequentialised
113
-- because packages are configured in the order respecting their dependencies.
114 115
packageTargets :: Bool -> Stage -> Package -> Action [FilePath]
packageTargets includeGhciLib stage pkg = do
Zhen Zhang's avatar
Zhen Zhang committed
116
    let context = vanillaContext stage pkg
Andrey Mokhov's avatar
Andrey Mokhov committed
117
    activePackages <- stagePackages stage
118 119 120 121
    if pkg `notElem` activePackages
    then return [] -- Skip inactive packages.
    else if isLibrary pkg
        then do -- Collect all targets of a library package.
122
            let pkgWays = if pkg == rts then getRtsWays else getLibraryWays
123 124
            ways  <- interpretInContext context pkgWays
            libs  <- mapM (pkgLibraryFile . Context stage pkg) ways
David Eichmann's avatar
David Eichmann committed
125
            more  <- Rules.Library.libraryTargets includeGhciLib context
126 127
            setupConfig <- pkgSetupConfigFile context
            return $ [setupConfig] ++ libs ++ more
128 129 130 131
        else do -- The only target of a program package is the executable.
            prgContext <- programContext stage pkg
            prgPath    <- programPath prgContext
            return [prgPath]
quchen's avatar
quchen committed
132

133
packageRules :: Rules ()
134
packageRules = do
135 136
    -- 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
137 138 139 140 141 142
    -- classic concurrent read exclusive write (CREW) conflict.
    let maxConcurrentReaders = 1000
    packageDb <- newResource "package-db" maxConcurrentReaders
    let readPackageDb  = [(packageDb, 1)]
        writePackageDb = [(packageDb, maxConcurrentReaders)]

143
    Rules.Compile.compilePackage readPackageDb
144 145 146 147
    Rules.Dependencies.buildPackageDependencies readPackageDb
    Rules.Documentation.buildPackageDocumentation
    Rules.Program.buildProgramRules readPackageDb
    Rules.Register.configurePackageRules
Zhen Zhang's avatar
Zhen Zhang committed
148

149
    forM_ [Stage0 ..] (Rules.Register.registerPackageRules writePackageDb)
Andrey Mokhov's avatar
Andrey Mokhov committed
150

151 152 153 154 155 156
    -- TODO: Can we get rid of this enumeration of contexts? Since we iterate
    --       over it to generate all 4 types of rules below, all the time, we
    --       might want to see whether the parse-and-extract approach of
    --       Rules.Compile and Rules.Library could save us some time there.
    let vanillaContexts = liftM2 vanillaContext allStages knownPackages

157
    forM_ vanillaContexts Rules.Generate.generatePackageCode
158
    Rules.SimpleTargets.simplePackageTargets
159
    Rules.SimpleTargets.completionRule
160 161

buildRules :: Rules ()
162
buildRules = do
163
    Rules.BinaryDist.bindistRules
164 165 166 167 168
    Rules.Configure.configureRules
    Rules.Generate.copyRules
    Rules.Generate.generateRules
    Rules.Gmp.gmpRules
    Rules.Libffi.libffiRules
169
    Rules.Library.libraryRules
170
    Rules.Rts.rtsRules
Andrey Mokhov's avatar
Andrey Mokhov committed
171
    packageRules
Zhen Zhang's avatar
Zhen Zhang committed
172

Andrey Mokhov's avatar
Andrey Mokhov committed
173 174 175
oracleRules :: Rules ()
oracleRules = do
    Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
176
    Hadrian.Oracles.Cabal.Rules.cabalOracle
Andrey Mokhov's avatar
Andrey Mokhov committed
177 178
    Hadrian.Oracles.DirectoryContents.directoryContentsOracle
    Hadrian.Oracles.Path.pathOracle
179
    Hadrian.Oracles.TextFile.textFileOracle
180
    Oracles.Flavour.oracles
Andrey Mokhov's avatar
Andrey Mokhov committed
181
    Oracles.ModuleFiles.moduleFilesOracle