ba4dab0442bb14c87572ff8827425f480cfa4e96
[ghc.git] / src / Rules / Program.hs
1 module Rules.Program (buildProgram) where
2
3 import Hadrian.Haskell.Cabal
4
5 import Base
6 import Context
7 import Expression hiding (stage, way)
8 import Oracles.ModuleFiles
9 import Oracles.PackageData
10 import Oracles.Setting
11 import Rules.Wrappers
12 import Settings
13 import Settings.Packages.Rts
14 import Target
15 import Utilities
16
17 -- | TODO: Drop code duplication
18 buildProgram :: [(Resource, Int)] -> Package -> Rules ()
19 buildProgram rs package = do
20 forM_ [Stage0 ..] $ \stage -> do
21 let context = vanillaContext stage package
22
23 -- Rules for programs built in 'buildRoot'
24 "//" ++ contextDir context -/- programName context <.> exe %> \bin ->
25 buildBinaryAndWrapper rs bin =<< programContext stage package
26
27 -- Rules for the GHC package, which is built 'inplace'
28 when (package == ghc) $ do
29 inplaceBinPath -/- programName context <.> exe %> \bin ->
30 buildBinaryAndWrapper rs bin =<< programContext stage package
31
32 inplaceLibBinPath -/- programName context <.> exe %> \bin ->
33 buildBinary rs bin =<< programContext stage package
34
35 inplaceLibBinPath -/- programName context <.> "bin" %> \bin ->
36 buildBinary rs bin =<< programContext stage package
37
38 -- Rules for other programs built in inplace directories
39 when (package /= ghc) $ do
40 let context0 = vanillaContext Stage0 package -- TODO: get rid of context0
41 inplaceBinPath -/- programName context0 <.> exe %> \bin -> do
42 stage <- installStage package -- TODO: get rid of fromJust
43 buildBinaryAndWrapper rs bin =<< programContext (fromJust stage) package
44
45 inplaceLibBinPath -/- programName context0 <.> exe %> \bin -> do
46 stage <- installStage package -- TODO: get rid of fromJust
47 context <- programContext (fromJust stage) package
48 if package /= iservBin then
49 -- We *normally* build only unwrapped binaries in inplace/lib/bin
50 buildBinary rs bin context
51 else
52 -- Build both binary and wrapper in inplace/lib/bin for iservBin
53 buildBinaryAndWrapperLib rs bin context
54
55 inplaceLibBinPath -/- programName context0 <.> "bin" %> \bin -> do
56 stage <- installStage package -- TODO: get rid of fromJust
57 buildBinary rs bin =<< programContext (fromJust stage) package
58
59 buildBinaryAndWrapperLib :: [(Resource, Int)] -> FilePath -> Context -> Action ()
60 buildBinaryAndWrapperLib rs bin context = do
61 windows <- windowsHost
62 if windows
63 then buildBinary rs bin context -- We don't build wrappers on Windows
64 else case lookup context inplaceWrappers of
65 Nothing -> buildBinary rs bin context -- No wrapper found
66 Just wrapper -> do
67 top <- topDirectory
68 let libdir = top -/- inplaceLibPath
69 let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin"
70 need [wrappedBin]
71 buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin))
72
73 buildBinaryAndWrapper :: [(Resource, Int)] -> FilePath -> Context -> Action ()
74 buildBinaryAndWrapper rs bin context = do
75 windows <- windowsHost
76 if windows
77 then buildBinary rs bin context -- We don't build wrappers on Windows
78 else case lookup context inplaceWrappers of
79 Nothing -> buildBinary rs bin context -- No wrapper found
80 Just wrapper -> do
81 top <- topDirectory
82 let libPath = top -/- inplaceLibPath
83 wrappedBin = inplaceLibBinPath -/- takeFileName bin
84 need [wrappedBin]
85 buildWrapper context wrapper bin (WrappedBinary libPath (takeFileName bin))
86
87 buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action ()
88 buildWrapper context@Context {..} wrapper wrapperPath wrapped = do
89 contents <- interpretInContext context $ wrapper wrapped
90 writeFileChanged wrapperPath contents
91 makeExecutable wrapperPath
92 putSuccess $ "| Successfully created wrapper for " ++
93 quote (pkgName package) ++ " (" ++ show stage ++ ")."
94
95 -- TODO: Get rid of the Paths_hsc2hs.o hack.
96 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
97 buildBinary rs bin context@Context {..} = do
98 binDeps <- if stage == Stage0 && package == ghcCabal
99 then hsSources context
100 else do
101 needLibrary =<< contextDependencies context
102 when (stage > Stage0) $ do
103 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
104 needLibrary [ rtsContext { way = w } | w <- ways ]
105 path <- buildPath context
106 cSrcs <- pkgDataList (CSrcs path)
107 cObjs <- mapM (objectPath context) cSrcs
108 hsObjs <- hsObjects context
109 return $ cObjs ++ hsObjs
110 ++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
111 ++ [ path -/- "Paths_haddock.o" | package == haddock ]
112 need binDeps
113 buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
114 synopsis <- traverse pkgSynopsis (pkgCabalFile package)
115 putSuccess $ renderProgram
116 (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis