GHC.hs 11.3 KB
Newer Older
Andrey Mokhov's avatar
Andrey Mokhov committed
1
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2
module GHC (
3
    -- * GHC packages
Andrey Mokhov's avatar
Andrey Mokhov committed
4
    array, base, binary, bytestring, cabal, checkApiAnnotations, compareSizes,
Andrey Mokhov's avatar
Andrey Mokhov committed
5
    compiler, containers, deepseq, deriveConstants, directory, filepath,
Andrey Mokhov's avatar
Andrey Mokhov committed
6
    genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci,
Zhen Zhang's avatar
Zhen Zhang committed
7
    ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps,
Andrey Mokhov's avatar
Andrey Mokhov committed
8 9 10
    hpc, hpcBin, integerGmp, integerSimple, iservBin, libffi, mtl, parsec,
    parallel, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
    terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml,
11
    ghcPackages, isGhcPackage, defaultPackages,
12 13

    -- * Package information
Andrey Mokhov's avatar
Andrey Mokhov committed
14
    programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
15 16

    -- * Miscellaneous
Andrey Mokhov's avatar
Andrey Mokhov committed
17
    programPath, ghcSplitPath, stripCmdPath, buildDll0
18
    ) where
19

20
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
21
import CommandLine
Andrey Mokhov's avatar
Andrey Mokhov committed
22
import Context
23
import Oracles.Setting
24
import Oracles.Flag (crossCompiling)
25

quchen's avatar
quchen committed
26
-- | These are all GHC packages we know about. Build rules will be generated for
27
-- all of them. However, not all of these packages will be built. For example,
28 29 30 31 32
-- package 'win32' is built only on Windows. 'defaultPackages' defines default
-- conditions for building each package. Users can add their own packages and
-- modify build default build conditions in "UserSettings".
ghcPackages :: [Package]
ghcPackages =
Andrey Mokhov's avatar
Andrey Mokhov committed
33
    [ array, base, binary, bytestring, cabal, checkApiAnnotations, compareSizes
Andrey Mokhov's avatar
Andrey Mokhov committed
34 35 36 37 38 39
    , compiler, containers, deepseq, deriveConstants, directory, filepath
    , genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact
    , ghci, ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc
    , hpcBin, integerGmp, integerSimple, iservBin, libffi, mtl, parsec, parallel
    , pretty, primitive, process, rts, runGhc, stm, templateHaskell, terminfo
    , text, time, touchy, transformers, unlit, unix, win32, xhtml ]
40

41 42 43 44
-- TODO: Optimise by switching to sets of packages.
isGhcPackage :: Package -> Bool
isGhcPackage = (`elem` ghcPackages)

45
-- | Package definitions, see 'Package'.
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
array               = hsLib  "array"
base                = hsLib  "base"
binary              = hsLib  "binary"
bytestring          = hsLib  "bytestring"
cabal               = hsLib  "Cabal"           `setPath` "libraries/Cabal/Cabal"
checkApiAnnotations = hsUtil "check-api-annotations"
compareSizes        = hsUtil "compareSizes"    `setPath` "utils/compare_sizes"
compiler            = hsTop  "ghc"             `setPath` "compiler"
containers          = hsLib  "containers"
deepseq             = hsLib  "deepseq"
deriveConstants     = hsUtil "deriveConstants"
directory           = hsLib  "directory"
filepath            = hsLib  "filepath"
genapply            = hsUtil "genapply"
genprimopcode       = hsUtil "genprimopcode"
ghc                 = hsPrg  "ghc-bin"         `setPath` "ghc"
ghcBoot             = hsLib  "ghc-boot"
ghcBootTh           = hsLib  "ghc-boot-th"
ghcCabal            = hsUtil "ghc-cabal"
ghcCompact          = hsLib  "ghc-compact"
ghci                = hsLib  "ghci"
ghcPkg              = hsUtil "ghc-pkg"
ghcPrim             = hsLib  "ghc-prim"
ghcTags             = hsUtil "ghctags"
ghcSplit            = hsUtil "ghc-split"
haddock             = hsUtil "haddock"
haskeline           = hsLib  "haskeline"
hsc2hs              = hsUtil "hsc2hs"
hp2ps               = cUtil  "hp2ps"
hpc                 = hsLib  "hpc"
hpcBin              = hsUtil "hpc-bin"         `setPath` "utils/hpc"
integerGmp          = hsLib  "integer-gmp"
integerSimple       = hsLib  "integer-simple"
iservBin            = hsPrg  "iserv-bin"       `setPath` "iserv"
libffi              = cTop   "libffi"
mtl                 = hsLib  "mtl"
parsec              = hsLib  "parsec"
parallel            = hsLib  "parallel"
pretty              = hsLib  "pretty"
primitive           = hsLib  "primitive"
process             = hsLib  "process"
rts                 = cTop   "rts"
runGhc              = hsUtil "runghc"
stm                 = hsLib  "stm"
templateHaskell     = hsLib  "template-haskell"
terminfo            = hsLib  "terminfo"
text                = hsLib  "text"
time                = hsLib  "time"
touchy              = cUtil  "touchy"
transformers        = hsLib  "transformers"
unlit               = cUtil  "unlit"
unix                = hsLib  "unix"
win32               = hsLib  "Win32"
xhtml               = hsLib  "xhtml"
Andrey Mokhov's avatar
Andrey Mokhov committed
100

101 102 103
-- | Construct a Haskell library package, e.g. @array@.
hsLib :: PackageName -> Package
hsLib name = hsLibrary name ("libraries" -/- name)
Andrey Mokhov's avatar
Andrey Mokhov committed
104

105 106 107
-- | Construct a top-level Haskell library package, e.g. @compiler@.
hsTop :: PackageName -> Package
hsTop name = hsLibrary name name
Andrey Mokhov's avatar
Andrey Mokhov committed
108

109 110 111
-- | Construct a top-level C library package, e.g. @rts@.
cTop :: PackageName -> Package
cTop name = cLibrary name name
Andrey Mokhov's avatar
Andrey Mokhov committed
112

113 114 115 116 117 118 119 120 121 122 123
-- | Construct a top-level Haskell program package, e.g. @ghc@.
hsPrg :: PackageName -> Package
hsPrg name = hsProgram name name

-- | Construct a Haskell utility package, e.g. @haddock@.
hsUtil :: PackageName -> Package
hsUtil name = hsProgram name ("utils" -/- name)

-- | Construct a C utility package, e.g. @haddock@.
cUtil :: PackageName -> Package
cUtil name = cProgram name ("utils" -/- name)
Andrey Mokhov's avatar
Andrey Mokhov committed
124 125 126

-- | Amend a package path if it doesn't conform to a typical pattern.
setPath :: Package -> FilePath -> Package
127
setPath pkg path = pkg { pkgPath = path }
128

Andrey Mokhov's avatar
Andrey Mokhov committed
129 130 131 132 133 134 135 136 137 138 139
-- | Packages that are built by default. You can change this in "UserSettings".
defaultPackages :: Stage -> Action [Package]
defaultPackages Stage0 = stage0Packages
defaultPackages Stage1 = stage1Packages
defaultPackages Stage2 = stage2Packages
defaultPackages Stage3 = return []

stage0Packages :: Action [Package]
stage0Packages = do
    win <- windowsHost
    ios <- iosHost
140
    cross <- crossCompiling
Andrey Mokhov's avatar
Andrey Mokhov committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164
    return $ [ binary
             , cabal
             , checkApiAnnotations
             , compareSizes
             , compiler
             , deriveConstants
             , genapply
             , genprimopcode
             , ghc
             , ghcBoot
             , ghcBootTh
             , ghcCabal
             , ghci
             , ghcPkg
             , ghcTags
             , hsc2hs
             , hp2ps
             , hpc
             , mtl
             , parsec
             , templateHaskell
             , text
             , transformers
             , unlit                       ]
165
          ++ [ terminfo | not win, not ios, not cross ]
Andrey Mokhov's avatar
Andrey Mokhov committed
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
          ++ [ touchy   | win              ]

stage1Packages :: Action [Package]
stage1Packages = do
    win        <- windowsHost
    doc        <- cmdBuildHaddock
    intSimple  <- cmdIntegerSimple
    libraries0 <- filter isLibrary <$> stage0Packages
    return $ libraries0 -- Build all Stage0 libraries in Stage1
          ++ [ array
             , base
             , bytestring
             , containers
             , deepseq
             , directory
             , filepath
             , ghc
             , ghcCabal
             , ghcCompact
             , ghcPrim
             , haskeline
             , hpcBin
             , hsc2hs
             , if intSimple then integerSimple else integerGmp
             , pretty
             , process
             , rts
             , runGhc
194
             , stm
Andrey Mokhov's avatar
Andrey Mokhov committed
195 196 197 198 199 200 201 202 203 204 205
             , time               ]
          ++ [ iservBin | not win ]
          ++ [ unix     | not win ]
          ++ [ win32    | win     ]
          ++ [ xhtml    | doc     ]

stage2Packages :: Action [Package]
stage2Packages = do
    doc <- cmdBuildHaddock
    return [ haddock | doc ]

Andrey Mokhov's avatar
Andrey Mokhov committed
206 207 208 209 210 211
-- | Given a 'Context', compute the name of the program that is built in it
-- assuming that the corresponding package's type is 'Program'. For example, GHC
-- built in 'Stage0' is called @ghc-stage1@. If the given package is a
-- 'Library', the function simply returns its name.
programName :: Context -> String
programName Context {..}
Zhen Zhang's avatar
Zhen Zhang committed
212 213 214 215
    | package == ghc      = "ghc-stage" ++ show (fromEnum stage + 1)
    | package == hpcBin   = "hpc"
    | package == runGhc   = "runhaskell"
    | package == iservBin = "ghc-iserv"
Andrey Mokhov's avatar
Andrey Mokhov committed
216
    | otherwise           = pkgName package
217

Andrey Mokhov's avatar
Andrey Mokhov committed
218 219 220 221 222 223
-- | The build stage whose results are used when installing a package, or
-- @Nothing@ if the package is not installed, e.g. because it is a user package.
-- The current implementation installs the /latest/ build stage of a package.
installStage :: Package -> Action (Maybe Stage)
installStage pkg
    | not (isGhcPackage pkg) = return Nothing -- Only GHC packages are installed
224
    | otherwise = do
225
        stages <- filterM (fmap (pkg `elem`) . defaultPackages) [Stage0 ..]
Andrey Mokhov's avatar
Andrey Mokhov committed
226
        return $ if null stages then Nothing else Just (maximum stages)
227

Andrey Mokhov's avatar
Andrey Mokhov committed
228 229 230 231 232 233 234 235 236 237 238
-- | Is the program corresponding to a given context built 'inplace', i.e. in
-- the @inplace/bin@ directory? For most programs, only their /latest/ build
-- stages are built 'inplace'. The only exception is the GHC itself, which is
-- built 'inplace' in all stages. The function returns @False@ for libraries and
-- all user packages.
isBuiltInplace :: Context -> Action Bool
isBuiltInplace Context {..}
    | isLibrary package          = return False
    | not (isGhcPackage package) = return False
    | package == ghc             = return True
    | otherwise                  = (Just stage ==) <$> installStage package
239 240 241 242 243

-- | The 'FilePath' to a program executable in a given 'Context'.
programPath :: Context -> Action FilePath
programPath context@Context {..} = do
    path    <- buildPath context
Andrey Mokhov's avatar
Andrey Mokhov committed
244 245
    inplace <- isBuiltInplace context
    let contextPath = if inplace then inplacePath else path
246
    return $ contextPath -/- programName context <.> exe
Andrey Mokhov's avatar
Andrey Mokhov committed
247 248 249
  where
    inplacePath | package `elem` [touchy, unlit, iservBin] = inplaceLibBinPath
                | otherwise                                = inplaceBinPath
250

Douglas Wilson's avatar
Douglas Wilson committed
251
-- | Some contexts are special: their packages do not have @.cabal@ metadata or
252 253 254 255 256
-- we cannot run @ghc-cabal@ on them, e.g. because the latter hasn't been built
-- yet (this is the case with the 'ghcCabal' package in 'Stage0').
nonCabalContext :: Context -> Bool
nonCabalContext Context {..} = (package `elem` [hp2ps, rts, touchy, unlit])
    || package == ghcCabal && stage == Stage0
257 258 259 260

-- | Some program packages should not be linked with Haskell main function.
nonHsMainPackage :: Package -> Bool
nonHsMainPackage = (`elem` [ghc, hp2ps, iservBin, touchy, unlit])
261 262 263 264 265 266 267 268

-- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
autogenPath :: Context -> Action FilePath
autogenPath context@Context {..}
    | isLibrary package   = autogen "build"
    | package == ghc      = autogen "build/ghc"
    | package == hpcBin   = autogen "build/hpc"
    | package == iservBin = autogen "build/iserv"
Andrey Mokhov's avatar
Andrey Mokhov committed
269
    | otherwise           = autogen $ "build" -/- pkgName package
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
  where
    autogen dir = buildPath context <&> (-/- dir -/- "autogen")

-- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
-- generated in "Rules.Generators.GhcSplit".
ghcSplitPath :: FilePath
ghcSplitPath = inplaceLibBinPath -/- "ghc-split"

-- ref: mk/config.mk
-- | Command line tool for stripping.
stripCmdPath :: Action FilePath
stripCmdPath = do
    targetPlatform <- setting TargetPlatform
    top <- topDirectory
    case targetPlatform of
        "x86_64-unknown-mingw32" ->
             return (top -/- "inplace/mingw/bin/strip.exe")
        "arm-unknown-linux" ->
             return ":" -- HACK: from the make-based system, see the ref above
        _ -> return "strip"

Andrey Mokhov's avatar
Andrey Mokhov committed
291 292 293 294
buildDll0 :: Context -> Action Bool
buildDll0 Context {..} = do
    windows <- windowsHost
    return $ windows && stage == Stage1 && package == compiler