Refactor Libffi and RTS rules
[ghc.git] / hadrian / src / Rules / Program.hs
1 module Rules.Program (buildProgramRules) where
2
3 import Hadrian.Haskell.Cabal
4 import Hadrian.Haskell.Cabal.Type
5
6 import Base
7 import Context
8 import Expression hiding (stage, way)
9 import Oracles.Flag
10 import Oracles.ModuleFiles
11 import Oracles.Setting (topDirectory)
12 import Packages
13 import Settings
14 import Settings.Default
15 import Target
16 import Utilities
17 import Rules.Library
18
19 -- | TODO: Drop code duplication
20 buildProgramRules :: [(Resource, Int)] -> Rules ()
21 buildProgramRules rs = do
22 root <- buildRootRules
23
24 -- Proxy rule for the whole mingw toolchain on Windows.
25 -- We 'need' configure because that's when the inplace/mingw
26 -- folder gets filled with the toolchain. This "proxy" rule
27 -- is listed as a runtime dependency for stage >= 1 GHCs.
28 root -/- mingwStamp %> \stampPath -> do
29 top <- topDirectory
30 need [ top -/- "configure" ]
31 copyDirectory (top -/- "inplace" -/- "mingw") root
32 writeFile' stampPath "OK"
33
34 -- Rules for programs that are actually built by hadrian.
35 forM_ [Stage0 ..] $ \stage ->
36 [ root -/- stageString stage -/- "bin" -/- "*"
37 , root -/- stageString stage -/- "lib/bin" -/- "*" ] |%> \bin -> do
38 programContexts <- getProgramContexts stage
39 case lookupProgramContext bin programContexts of
40 Nothing -> error $ "Unknown program " ++ show bin
41 Just ctx -> buildProgram bin ctx rs
42
43 getProgramContexts :: Stage -> Action [(FilePath, Context)]
44 getProgramContexts stage = do
45 -- This is quite inefficient, but we can't access 'programName' from
46 -- 'Rules', because it is an 'Action' depending on an oracle.
47 sPackages <- filter isProgram <$> stagePackages stage
48 tPackages <- testsuitePackages
49 -- TODO: Shall we use Stage2 for testsuite packages instead?
50 let allPackages = sPackages
51 ++ if stage == Stage1 then tPackages else []
52 fmap concat . forM allPackages $ \pkg -> do
53 -- the iserv pkg results in three different programs at
54 -- the moment, ghc-iserv (built the vanilla way),
55 -- ghc-iserv-prof (built the profiling way), and
56 -- ghc-iserv-dyn (built the dynamic way).
57 -- The testsuite requires all to be present, so we
58 -- make sure that we cover these
59 -- "prof-build-under-other-name" cases.
60 -- iserv gets its names from Packages.hs:programName
61 ctx <- programContext stage pkg -- TODO: see todo on programContext.
62 let allCtxs = if pkg == iserv
63 then [ vanillaContext stage pkg
64 , Context stage pkg profiling
65 , Context stage pkg dynamic
66 ]
67 else [ ctx ]
68 forM allCtxs $ \ctx -> do
69 name <- programName ctx
70 return (name <.> exe, ctx)
71
72 lookupProgramContext :: FilePath -> [(FilePath, Context)] -> Maybe Context
73 lookupProgramContext wholePath progs = lookup (takeFileName wholePath) progs
74
75 buildProgram :: FilePath -> Context -> [(Resource, Int)] -> Action ()
76 buildProgram bin ctx@(Context{..}) rs = do
77 -- Custom dependencies: this should be modeled better in the
78 -- Cabal file somehow.
79 -- TODO: Is this still needed? See 'runtimeDependencies'.
80 when (package == hsc2hs) $ do
81 -- 'Hsc2hs' needs the @template-hsc.h@ file.
82 template <- templateHscPath stage
83 need [template]
84 when (package == ghc) $ do
85 -- GHC depends on @settings@, @platformConstants@,
86 -- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt@,
87 -- @llvm-passes@.
88 need =<< ghcDeps stage
89 when (package == haddock) $ do
90 -- Haddock has a resource folder
91 need =<< haddockDeps stage
92
93 -- Need library dependencies.
94 -- Note pkgLibraryFile gets the path in the build dir e.g.
95 -- _build/stage1/libraries/haskeline/build/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so
96 -- but when building the program, we link against the *ghc-pkg registered* library e.g.
97 -- _build/stage1/lib/x86_64-linux-ghc-8.9.0.20190430/libHShaskeline-0.7.5.0-ghc8.9.0.20190430.so
98 -- so we use pkgRegisteredLibraryFile instead.
99 need =<< mapM pkgRegisteredLibraryFile
100 =<< contextDependencies ctx
101
102 cross <- flag CrossCompiling
103 -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
104 case (cross, stage) of
105 (True, s) | s > Stage0 -> do
106 srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
107 copyFile (srcDir -/- takeFileName bin) bin
108 (False, s) | s > Stage0 && (package `elem` [touchy, unlit]) -> do
109 srcDir <- stageLibPath Stage0 <&> (-/- "bin")
110 copyFile (srcDir -/- takeFileName bin) bin
111 _ -> buildBinary rs bin ctx
112
113 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
114 buildBinary rs bin context@Context {..} = do
115 needLibrary =<< contextDependencies context
116 when (stage > Stage0) $ do
117 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
118 needLibrary [ (rtsContext stage) { way = w } | w <- ways ]
119 cSrcs <- interpretInContext context (getContextData cSrcs)
120 cObjs <- mapM (objectPath context) cSrcs
121 hsObjs <- hsObjects context
122 let binDeps = cObjs ++ hsObjs
123 need binDeps
124 buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
125 synopsis <- pkgSynopsis package
126 putSuccess $ renderProgram
127 (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis