e6e5b167ff959a59ae269c100404971dacc42335
[ghc.git] / hadrian / src / Rules / Library.hs
1 module Rules.Library (
2 buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
3 ) where
4
5 import Hadrian.Haskell.Cabal
6 import qualified System.Directory as IO
7
8 import Base
9 import Context
10 import Expression hiding (way, package)
11 import Flavour
12 import Oracles.ModuleFiles
13 import Oracles.PackageData
14 import Oracles.Setting
15 import Rules.Gmp
16 import Settings
17 import Target
18 import Utilities
19
20 libraryObjects :: Context -> Action [FilePath]
21 libraryObjects context@Context{..} = do
22 hsObjs <- hsObjects context
23 noHsObjs <- nonHsObjects context
24
25 -- This will create split objects if required (we don't track them
26 -- explicitly as this would needlessly bloat the Shake database).
27 need $ noHsObjs ++ hsObjs
28
29 split <- interpretInContext context =<< splitObjects <$> flavour
30 let getSplitObjs = concatForM hsObjs $ \obj -> do
31 let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
32 contents <- liftIO $ IO.getDirectoryContents dir
33 return . map (dir -/-) $ filter (not . all (== '.')) contents
34
35 (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs
36
37 buildDynamicLib :: Context -> Rules ()
38 buildDynamicLib context@Context{..} = do
39 let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
40 -- OS X
41 libPrefix ++ "*.dylib" %> buildDynamicLibUnix
42 -- Linux
43 libPrefix ++ "*.so" %> buildDynamicLibUnix
44 -- TODO: Windows
45 where
46 buildDynamicLibUnix lib = do
47 deps <- contextDependencies context
48 need =<< mapM pkgLibraryFile deps
49 objs <- libraryObjects context
50 build $ target context (Ghc LinkHs stage) objs [lib]
51
52 buildPackageLibrary :: Context -> Rules ()
53 buildPackageLibrary context@Context {..} = do
54 let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package
55 libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do
56 objs <- libraryObjects context
57 asuf <- libsuf way
58 let isLib0 = ("//*-0" ++ asuf) ?== a
59 removeFile a
60 if isLib0 then build $ target context (Ar Pack stage) [] [a] -- TODO: Scan for dlls
61 else build $ target context (Ar Pack stage) objs [a]
62
63 synopsis <- traverse pkgSynopsis (pkgCabalFile package)
64 unless isLib0 . putSuccess $ renderLibrary
65 (quote (pkgName package) ++ " (" ++ show stage ++ ", way "
66 ++ show way ++ ").") a synopsis
67
68 buildPackageGhciLibrary :: Context -> Rules ()
69 buildPackageGhciLibrary context@Context {..} = priority 2 $ do
70 let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package
71 libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do
72 objs <- allObjects context
73 need objs
74 build $ target context Ld objs [obj]
75
76 allObjects :: Context -> Action [FilePath]
77 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
78
79 nonHsObjects :: Context -> Action [FilePath]
80 nonHsObjects context = do
81 path <- buildPath context
82 cObjs <- cObjects context
83 cmmSrcs <- pkgDataList (CmmSrcs path)
84 cmmObjs <- mapM (objectPath context) cmmSrcs
85 eObjs <- extraObjects context
86 return $ cObjs ++ cmmObjs ++ eObjs
87
88 cObjects :: Context -> Action [FilePath]
89 cObjects context = do
90 path <- buildPath context
91 srcs <- pkgDataList (CSrcs path)
92 objs <- mapM (objectPath context) srcs
93 return $ if way context == threaded
94 then objs
95 else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
96
97 extraObjects :: Context -> Action [FilePath]
98 extraObjects context
99 | package context == integerGmp = do
100 gmpPath <- gmpBuildPath
101 need [gmpPath -/- gmpLibraryH]
102 map unifyPath <$> getDirectoryFiles "" [gmpPath -/- gmpObjectsDir -/- "*.o"]
103 | otherwise = return []