Program.hs 4.6 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 Rules.Wrappers
Andrey Mokhov's avatar
Andrey Mokhov committed
14
import Settings
15
import Settings.Path
16
import Target
Andrey Mokhov's avatar
Andrey Mokhov committed
17
import UserSettings
18
import Util
Andrey Mokhov's avatar
Andrey Mokhov committed
19

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

Andrey Mokhov's avatar
Andrey Mokhov committed
26
27
28
    buildPath context -/- programName context <.> exe %>
        buildBinaryAndWrapper rs context

29
30
    when (package == ghc) $ want inplaceLibCopyTargets

Andrey Mokhov's avatar
Andrey Mokhov committed
31
    -- 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
Zhen Zhang's avatar
Zhen Zhang committed
37

38
        inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
Zhen Zhang's avatar
Zhen Zhang committed
39
40
41
42
43
44
45
46
47
48
            binStage <- installStage
            if package /= iservBin then
                -- We *normally* build only unwrapped binaries in inplace/lib/bin,
                buildBinary rs (context { stage = binStage }) bin
            else
                -- build both binary and wrapper in inplace/lib/bin
                -- for ghc-iserv on *nix platform now
                buildBinaryAndWrapperLib rs (context { stage = binStage }) bin

        inplaceLibBinPath -/- programName context <.> "bin" %> \bin -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
49
50
            binStage <- installStage
            buildBinary rs (context { stage = binStage }) bin
Andrey Mokhov's avatar
Andrey Mokhov committed
51

Zhen Zhang's avatar
Zhen Zhang committed
52
53
54
55
56
57
58
59
60
61
62
63
64
65
buildBinaryAndWrapperLib :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildBinaryAndWrapperLib rs context bin = do
    windows <- windowsHost
    if windows
    then buildBinary rs context bin -- We don't build wrappers on Windows
    else case lookup context inplaceWrappers of
        Nothing      -> buildBinary rs context bin -- No wrapper found
        Just wrapper -> do
            top <- topDirectory
            let libdir = top -/- inplaceLibPath
            let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin"
            need [wrappedBin]
            buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin))

Andrey Mokhov's avatar
Andrey Mokhov committed
66
67
68
69
70
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
71
    else case lookup context inplaceWrappers of
Andrey Mokhov's avatar
Andrey Mokhov committed
72
73
        Nothing      -> buildBinary rs context bin -- No wrapper found
        Just wrapper -> do
74
75
76
            top <- topDirectory
            let libdir = top -/- inplaceLibPath
            let wrappedBin = inplaceLibBinPath -/- takeFileName bin
Andrey Mokhov's avatar
Andrey Mokhov committed
77
            need [wrappedBin]
78
            buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
Andrey Mokhov's avatar
Andrey Mokhov committed
79

80
81
82
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
83
    writeFileChanged wrapperPath contents
84
    makeExecutable wrapperPath
Andrey Mokhov's avatar
Andrey Mokhov committed
85
86
    putSuccess $ "| Successfully created wrapper for " ++
        quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
Andrey Mokhov's avatar
Andrey Mokhov committed
87
88

-- TODO: Get rid of the Paths_hsc2hs.o hack.
89
buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
Andrey Mokhov's avatar
Andrey Mokhov committed
90
91
buildBinary rs context@Context {..} bin = do
    binDeps <- if stage == Stage0 && package == ghcCabal
92
        then hsSources context
Andrey Mokhov's avatar
Andrey Mokhov committed
93
        else do
94
            needLibrary =<< contextDependencies context
95
            when (stage > Stage0) $ do
96
                ways <- interpretInContext context (getLibraryWays <> getRtsWays)
97
                needLibrary [ rtsContext { way = w } | w <- ways ]
Andrey Mokhov's avatar
Andrey Mokhov committed
98
            let path = buildPath context
99
100
101
102
103
            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
104
    need binDeps
105
    buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
106
    synopsis <- interpretInContext context $ getPkgData Synopsis
Moritz Angermann's avatar
Moritz Angermann committed
107
    putSuccess $ renderProgram
Andrey Mokhov's avatar
Andrey Mokhov committed
108
        (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
Moritz Angermann's avatar
Moritz Angermann committed
109
110
        bin
        (dropWhileEnd isPunctuation synopsis)