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