5b2e66f080140152f595f6d3f81d5e39e880abb1
[hadrian.git] / src / Rules / Program.hs
1 module Rules.Program (buildProgram) where
2
3 import Data.Char
4
5 import Base
6 import Context
7 import Expression
8 import GHC
9 import Oracles.Config.Setting
10 import Oracles.Dependencies
11 import Oracles.ModuleFiles
12 import Oracles.PackageData
13 import Oracles.Path (topDirectory)
14 import Rules.Wrappers (WrappedBinary(..), Wrapper,
15 ghcWrapper, runGhcWrapper, inplaceGhcPkgWrapper,
16 hpcWrapper, hp2psWrapper, hsc2hsWrapper)
17 import Settings
18 import Settings.Path (buildPath, inplaceLibBinPath, rtsContext, objectPath,
19 inplaceLibPath, inplaceBinPath)
20 import Target
21 import UserSettings
22 import Util
23
24 -- | List of wrappers we build.
25 wrappers :: [(Context, Wrapper)]
26 wrappers = [ (vanillaContext Stage0 ghc , ghcWrapper)
27 , (vanillaContext Stage1 ghc , ghcWrapper)
28 , (vanillaContext Stage1 runGhc, runGhcWrapper)
29 , (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper)
30 , (vanillaContext Stage1 hp2ps , hp2psWrapper)
31 , (vanillaContext Stage1 hpc , hpcWrapper)
32 , (vanillaContext Stage1 hsc2hs, hsc2hsWrapper) ]
33
34 buildProgram :: [(Resource, Int)] -> Context -> Rules ()
35 buildProgram rs context@Context {..} = when (isProgram package) $ do
36 let installStage = do
37 latest <- latestBuildStage package -- fromJust below is safe
38 return $ if package == ghc then stage else fromJust latest
39
40 buildPath context -/- programName context <.> exe %>
41 buildBinaryAndWrapper rs context
42
43 -- Rules for programs built in install directories
44 when (stage == Stage0 || package == ghc) $ do
45 -- Some binaries in inplace/bin are wrapped
46 inplaceBinPath -/- programName context <.> exe %> \bin -> do
47 binStage <- installStage
48 buildBinaryAndWrapper rs (context { stage = binStage }) bin
49 -- We build only unwrapped binaries in inplace/lib/bin
50 inplaceLibBinPath -/- programName context <.> exe %> \bin -> do
51 binStage <- installStage
52 buildBinary rs (context { stage = binStage }) bin
53
54 buildBinaryAndWrapper :: [(Resource, Int)] -> Context -> FilePath -> Action ()
55 buildBinaryAndWrapper rs context bin = do
56 windows <- windowsHost
57 if windows
58 then buildBinary rs context bin -- We don't build wrappers on Windows
59 else case lookup context wrappers of
60 Nothing -> buildBinary rs context bin -- No wrapper found
61 Just wrapper -> do
62 top <- topDirectory
63 let libdir = top -/- inplaceLibPath
64 let wrappedBin = inplaceLibBinPath -/- takeFileName bin
65 need [wrappedBin]
66 buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName bin))
67
68 buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
69 buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
70 contents <- interpretInContext context $ wrapper wrapped
71 writeFileChanged wrapperPath contents
72 makeExecutable wrapperPath
73 putSuccess $ "| Successfully created wrapper for " ++
74 quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
75
76 -- TODO: Get rid of the Paths_hsc2hs.o hack.
77 buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
78 buildBinary rs context@Context {..} bin = do
79 binDeps <- if stage == Stage0 && package == ghcCabal
80 then hsSources context
81 else do
82 needContext =<< contextDependencies context
83 when (stage > Stage0) $ do
84 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
85 needContext [ rtsContext { way = w } | w <- ways ]
86 let path = buildPath context
87 cObjs <- map (objectPath context) <$> pkgDataList (CSrcs path)
88 hsObjs <- hsObjects context
89 return $ cObjs ++ hsObjs
90 ++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
91 ++ [ path -/- "Paths_haddock.o" | package == haddock ]
92 need binDeps
93 buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
94 synopsis <- interpretInContext context $ getPkgData Synopsis
95 putSuccess $ renderProgram
96 (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
97 bin
98 (dropWhileEnd isPunctuation synopsis)