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