Refactor package-specific settings (#622)
[hadrian.git] / src / Rules / Program.hs
1 module Rules.Program (buildProgram) where
2
3 import Hadrian.Haskell.Cabal
4 import Hadrian.Haskell.Cabal.PackageData as PD
5
6 import Base
7 import Context
8 import Expression hiding (stage, way)
9 import GHC
10 import Oracles.Flag
11 import Oracles.ModuleFiles
12 import Settings
13 import Target
14 import Utilities
15
16 -- | TODO: Drop code duplication
17 buildProgram :: [(Resource, Int)] -> Rules ()
18 buildProgram rs = do
19 root <- buildRootRules
20 forM_ [Stage0 ..] $ \stage ->
21 [ root -/- stageString stage -/- "bin" -/- "*"
22 , root -/- stageString stage -/- "lib/bin" -/- "*" ] |%> \bin -> do
23 -- This is quite inefficient, but we can't access 'programName' from
24 -- 'Rules', because it is an 'Action' depending on an oracle.
25 sPackages <- filter isProgram <$> stagePackages stage
26 tPackages <- testsuitePackages
27 -- TODO: Shall we use Stage2 for testsuite packages instead?
28 let allPackages = sPackages
29 ++ if stage == Stage1 then tPackages else []
30 nameToCtxList <- forM allPackages $ \pkg -> do
31 let ctx = vanillaContext stage pkg
32 name <- programName ctx
33 return (name <.> exe, ctx)
34
35 case lookup (takeFileName bin) nameToCtxList of
36 Nothing -> error $ "Unknown program " ++ show bin
37 Just (Context {..}) -> do
38 -- Custom dependencies: this should be modeled better in the
39 -- Cabal file somehow.
40 -- TODO: Is this still needed? See 'runtimeDependencies'.
41 when (package == hsc2hs) $ do
42 -- 'Hsc2hs' needs the @template-hsc.h@ file.
43 template <- templateHscPath stage
44 need [template]
45 when (package == ghc) $ do
46 -- GHC depends on @settings@, @platformConstants@,
47 -- @llvm-targets@, @ghc-usage.txt@, @ghci-usage.txt@,
48 -- @llvm-passes@.
49 need =<< ghcDeps stage
50
51 cross <- flag CrossCompiling
52 -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@.
53 case (cross, stage) of
54 (True, s) | s > Stage0 -> do
55 srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin"))
56 copyFile (srcDir -/- takeFileName bin) bin
57 _ -> buildBinary rs bin =<< programContext stage package
58
59 buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action ()
60 buildBinary rs bin context@Context {..} = do
61 binDeps <- if stage == Stage0 && package == ghcCabal
62 then hsSources context
63 else do
64 needLibrary =<< contextDependencies context
65 when (stage > Stage0) $ do
66 ways <- interpretInContext context (getLibraryWays <> getRtsWays)
67 needLibrary [ rtsContext { way = w } | w <- ways ]
68 cSrcs <- interpretInContext context (getPackageData PD.cSrcs)
69 cObjs <- mapM (objectPath context) cSrcs
70 hsObjs <- hsObjects context
71 return $ cObjs ++ hsObjs
72 need binDeps
73 buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
74 synopsis <- pkgSynopsis context
75 putSuccess $ renderProgram
76 (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis