GHC.hs 7.46 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, checkPpr,
5 6
    compareSizes, compiler, containers, deepseq, deriveConstants, directory,
    filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal,
Andrey Mokhov's avatar
Andrey Mokhov committed
7 8 9 10 11
    ghcCompact, ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock,
    haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv,
    libffi, libiserv, mtl, parsec, parallel, pretty, primitive, process, rts,
    runGhc, stm, templateHaskell, terminfo, text, time, touchy, transformers,
    unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages,
12
    testsuitePackages,
13 14

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

    -- * Miscellaneous
18 19
    programPath, buildDll0, rtsContext, rtsBuildPath, libffiContext,
    libffiBuildPath, libffiLibraryName
20
    ) where
21

22
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
23
import Context
24 25
import Flavour
import GHC.Packages
26
import Oracles.Flag
27
import Oracles.Setting
28
import Settings (flavour)
29

Andrey Mokhov's avatar
Andrey Mokhov committed
30 31 32 33 34 35 36 37 38 39
-- | 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
Andrey Mokhov's avatar
Andrey Mokhov committed
40
    cross <- flag CrossCompiling
Andrey Mokhov's avatar
Andrey Mokhov committed
41 42 43 44 45 46 47 48 49 50
    return $ [ binary
             , cabal
             , compareSizes
             , compiler
             , deriveConstants
             , genapply
             , genprimopcode
             , ghc
             , ghcBoot
             , ghcBootTh
Andrey Mokhov's avatar
Andrey Mokhov committed
51
             , ghcHeap
Andrey Mokhov's avatar
Andrey Mokhov committed
52 53 54 55 56 57 58 59 60 61 62
             , ghci
             , ghcPkg
             , ghcTags
             , hsc2hs
             , hp2ps
             , hpc
             , mtl
             , parsec
             , templateHaskell
             , text
             , transformers
63 64 65
             , unlit                         ]
          ++ [ terminfo | not win, not cross ]
          ++ [ touchy   | win                ]
Andrey Mokhov's avatar
Andrey Mokhov committed
66 67 68 69

stage1Packages :: Action [Package]
stage1Packages = do
    win        <- windowsHost
70
    intLib     <- integerLibrary =<< flavour
Andrey Mokhov's avatar
Andrey Mokhov committed
71
    libraries0 <- filter isLibrary <$> stage0Packages
Andrey Mokhov's avatar
Andrey Mokhov committed
72
    cross      <- flag CrossCompiling
Andrey Mokhov's avatar
Andrey Mokhov committed
73 74 75 76 77 78 79 80 81 82
    return $ libraries0 -- Build all Stage0 libraries in Stage1
          ++ [ array
             , base
             , bytestring
             , containers
             , deepseq
             , directory
             , filepath
             , ghc
             , ghcCompact
83
             , ghcPkg
Andrey Mokhov's avatar
Andrey Mokhov committed
84 85 86
             , ghcPrim
             , haskeline
             , hsc2hs
87
             , intLib
Andrey Mokhov's avatar
Andrey Mokhov committed
88 89 90
             , pretty
             , process
             , rts
91
             , stm
92
             , time
93 94 95 96 97
             , unlit
             , xhtml                         ]
          ++ [ haddock  | not cross          ]
          ++ [ runGhc   | not cross          ]
          ++ [ hpcBin   | not cross          ]
98 99
          ++ [ iserv    | not win, not cross ]
          ++ [ libiserv | not win, not cross ]
100 101
          ++ [ unix     | not win            ]
          ++ [ win32    | win                ]
Andrey Mokhov's avatar
Andrey Mokhov committed
102 103

stage2Packages :: Action [Package]
104
stage2Packages = return [haddock]
Andrey Mokhov's avatar
Andrey Mokhov committed
105

106 107
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
108 109
testsuitePackages = return [ checkApiAnnotations
                           , checkPpr
110 111
                           , ghcPkg
                           , parallel
Andrey Mokhov's avatar
Andrey Mokhov committed
112
                           , hp2ps              ]
113

Andrey Mokhov's avatar
Andrey Mokhov committed
114 115 116 117
-- | 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.
118 119
programName :: Context -> Action String
programName Context {..} = do
Andrey Mokhov's avatar
Andrey Mokhov committed
120
    cross <- flag CrossCompiling
121 122 123
    targetPlatform <- setting TargetPlatformFull
    let prefix = if cross then targetPlatform ++ "-" else ""
      in return $ prefix ++ case package of
124 125 126 127 128
                              p | p == ghc    -> "ghc"
                                | p == hpcBin -> "hpc"
                                | p == runGhc -> "runhaskell"
                                | p == iserv  -> "ghc-iserv"
                              _               ->  pkgName package
129

Andrey Mokhov's avatar
Andrey Mokhov committed
130 131 132 133 134 135
-- | 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
136
    | otherwise = do
137
        stages <- filterM (fmap (pkg `elem`) . defaultPackages) [Stage0 ..]
Andrey Mokhov's avatar
Andrey Mokhov committed
138
        return $ if null stages then Nothing else Just (maximum stages)
139

140 141 142
-- | The 'FilePath' to a program executable in a given 'Context'.
programPath :: Context -> Action FilePath
programPath context@Context {..} = do
Andrey Mokhov's avatar
Andrey Mokhov committed
143 144 145
    -- The @touchy@ utility lives in the @lib/bin@ directory instead of @bin@,
    -- which is likely just a historical accident that will hopefully be fixed.
    -- See: https://github.com/snowleopard/hadrian/issues/570
146 147 148 149
    -- Likewise for 'unlit'.
    path <- if package `elem` [touchy, unlit]
      then stageLibPath stage <&> (-/- "bin")
      else stageBinPath stage
Andrey Mokhov's avatar
Andrey Mokhov committed
150
    pgm  <- programName context
151
    return $ path -/- pgm <.> exe
152

Douglas Wilson's avatar
Douglas Wilson committed
153
-- | Some contexts are special: their packages do not have @.cabal@ metadata or
154 155 156
-- 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
157 158 159
nonCabalContext Context {..} = (package `elem` [ hp2ps
                                               , touchy
                                               ])
160
    || package == ghcCabal && stage == Stage0
161 162 163

-- | Some program packages should not be linked with Haskell main function.
nonHsMainPackage :: Package -> Bool
164
nonHsMainPackage = (`elem` [ghc, hp2ps, iserv, touchy, unlit])
165 166 167 168

-- | Path to the autogen directory generated by @ghc-cabal@ of a given 'Context'.
autogenPath :: Context -> Action FilePath
autogenPath context@Context {..}
169 170 171 172
    | isLibrary package = autogen "build"
    | package == ghc    = autogen "build/ghc"
    | package == hpcBin = autogen "build/hpc"
    | otherwise         = autogen $ "build" -/- pkgName package
173
  where
174 175
    autogen dir = contextPath context <&> (-/- dir -/- "autogen")

Andrey Mokhov's avatar
Andrey Mokhov committed
176 177 178 179
buildDll0 :: Context -> Action Bool
buildDll0 Context {..} = do
    windows <- windowsHost
    return $ windows && stage == Stage1 && package == compiler
180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204

-- | RTS is considered a Stage1 package. This determines RTS build directory.
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts

-- | Path to the RTS build directory.
rtsBuildPath :: Action FilePath
rtsBuildPath = buildPath rtsContext

-- | Libffi is considered a Stage1 package. This determines its build directory.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi

-- | Build directory for in-tree Libffi library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext

libffiLibraryName :: Action FilePath
libffiLibraryName = do
    useSystemFfi <- flag UseSystemFfi
    windows      <- windowsHost
    return $ case (useSystemFfi, windows) of
        (True , False) -> "ffi"
        (False, False) -> "Cffi"
        (_    , True ) -> "Cffi-6"