Program.hs 3.62 KB
Newer Older
Andrey Mokhov's avatar
Andrey Mokhov committed
1
2
module Rules.Program (buildProgram) where

Ben Gamari's avatar
Ben Gamari committed
3
4
import Data.Char

Ben Gamari's avatar
Ben Gamari committed
5
import Base
6
import Context
7
import Expression
8
import GHC
Andrey Mokhov's avatar
Andrey Mokhov committed
9
import Oracles.Config.Setting
Andrey Mokhov's avatar
Andrey Mokhov committed
10
import Oracles.Dependencies
11
import Oracles.ModuleFiles
Andrey Mokhov's avatar
Andrey Mokhov committed
12
import Oracles.PackageData
13
import Oracles.Path (topDirectory)
Zhen Zhang's avatar
Zhen Zhang committed
14
import Rules.Wrappers (WrappedBinary(..), Wrapper, inplaceWrappers)
Andrey Mokhov's avatar
Andrey Mokhov committed
15
import Settings
16
17
import Settings.Path (buildPath, inplaceLibBinPath, rtsContext, objectPath,
                      inplaceLibPath, inplaceBinPath)
18
import Target
Andrey Mokhov's avatar
Andrey Mokhov committed
19
import UserSettings
20
import Util
Andrey Mokhov's avatar
Andrey Mokhov committed
21

22
buildProgram :: [(Resource, Int)] -> Context -> Rules ()
Andrey Mokhov's avatar
Andrey Mokhov committed
23
buildProgram rs context@Context {..} = when (isProgram package) $ do
Andrey Mokhov's avatar
Andrey Mokhov committed
24
    let installStage = do
Andrey Mokhov's avatar
Andrey Mokhov committed
25
            latest <- latestBuildStage package -- fromJust below is safe
Andrey Mokhov's avatar
Andrey Mokhov committed
26
27
            return $ if package == ghc then stage else fromJust latest

Andrey Mokhov's avatar
Andrey Mokhov committed
28
29
30
31
    buildPath context -/- programName context <.> exe %>
        buildBinaryAndWrapper rs context

    -- Rules for programs built in install directories
Andrey Mokhov's avatar
Andrey Mokhov committed
32
    when (stage == Stage0 || package == ghc) $ do
33
34
        -- Some binaries in inplace/bin are wrapped
        inplaceBinPath -/- programName context <.> exe %> \bin -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
35
            binStage <- installStage
Andrey Mokhov's avatar
Andrey Mokhov committed
36
            buildBinaryAndWrapper rs (context { stage = binStage }) bin
37
38
        -- We build only unwrapped binaries in inplace/lib/bin
        inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
39
40
            binStage <- installStage
            buildBinary rs (context { stage = binStage }) bin
Andrey Mokhov's avatar
Andrey Mokhov committed
41
42
43
44
45
46

buildBinaryAndWrapper :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildBinaryAndWrapper rs context bin = do
    windows <- windowsHost
    if windows
    then buildBinary rs context bin -- We don't build wrappers on Windows
Zhen Zhang's avatar
Zhen Zhang committed
47
    else case lookup context inplaceWrappers of
Andrey Mokhov's avatar
Andrey Mokhov committed
48
49
        Nothing      -> buildBinary rs context bin -- No wrapper found
        Just wrapper -> do
50
51
52
            top <- topDirectory
            let libdir = top -/- inplaceLibPath
            let wrappedBin = inplaceLibBinPath -/- takeFileName bin
Andrey Mokhov's avatar
Andrey Mokhov committed
53
            need [wrappedBin]
54
            buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
Andrey Mokhov's avatar
Andrey Mokhov committed
55

56
57
58
buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
    contents <- interpretInContext context $ wrapper wrapped
Andrey Mokhov's avatar
Andrey Mokhov committed
59
    writeFileChanged wrapperPath contents
60
    makeExecutable wrapperPath
Andrey Mokhov's avatar
Andrey Mokhov committed
61
62
    putSuccess $ "| Successfully created wrapper for " ++
        quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
Andrey Mokhov's avatar
Andrey Mokhov committed
63
64

-- TODO: Get rid of the Paths_hsc2hs.o hack.
65
buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
Andrey Mokhov's avatar
Andrey Mokhov committed
66
67
buildBinary rs context@Context {..} bin = do
    binDeps <- if stage == Stage0 && package == ghcCabal
68
        then hsSources context
Andrey Mokhov's avatar
Andrey Mokhov committed
69
        else do
70
            needContext =<< contextDependencies context
71
            when (stage > Stage0) $ do
72
73
                ways <- interpretInContext context (getLibraryWays <> getRtsWays)
                needContext [ rtsContext { way = w } | w <- ways ]
Andrey Mokhov's avatar
Andrey Mokhov committed
74
            let path = buildPath context
75
76
77
78
79
            cObjs  <- map (objectPath context) <$> pkgDataList (CSrcs path)
            hsObjs <- hsObjects context
            return $ cObjs ++ hsObjs
                  ++ [ path -/- "Paths_hsc2hs.o"  | package == hsc2hs  ]
                  ++ [ path -/- "Paths_haddock.o" | package == haddock ]
Andrey Mokhov's avatar
Andrey Mokhov committed
80
    need binDeps
81
    buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
82
    synopsis <- interpretInContext context $ getPkgData Synopsis
Moritz Angermann's avatar
Moritz Angermann committed
83
    putSuccess $ renderProgram
Andrey Mokhov's avatar
Andrey Mokhov committed
84
        (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
Moritz Angermann's avatar
Moritz Angermann committed
85
86
        bin
        (dropWhileEnd isPunctuation synopsis)