edec160cc2d7e3ea2e6d4bb600553e0efa2ba9fb
[ghc.git] / hadrian / src / Rules / Library.hs
1 module Rules.Library (libraryRules) where
2
3 import Hadrian.BuildPath
4 import Hadrian.Haskell.Cabal
5 import Hadrian.Haskell.Cabal.Type
6 import qualified System.Directory as IO
7 import qualified Text.Parsec as Parsec
8
9 import Base
10 import Context
11 import Expression hiding (way, package)
12 import Flavour
13 import Oracles.ModuleFiles
14 import Packages
15 import Rules.Gmp
16 import Rules.Libffi (libffiDependencies)
17 import Settings
18 import Target
19 import Utilities
20
21 -- * Library 'Rules'
22
23 libraryRules :: Rules ()
24 libraryRules = do
25 root <- buildRootRules
26 root -/- "//libHS*-*.dylib" %> buildDynamicLibUnix root "dylib"
27 root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so"
28 root -/- "//*.a" %> buildStaticLib root
29 priority 2 $ do
30 root -/- "//HS*-*.o" %> buildGhciLibO root
31 root -/- "//HS*-*.p_o" %> buildGhciLibO root
32
33 -- * 'Action's for building libraries
34
35 -- | Build a static library ('LibA') under the given build root, whose path is
36 -- the second argument.
37 buildStaticLib :: FilePath -> FilePath -> Action ()
38 buildStaticLib root archivePath = do
39 l@(BuildPath _ stage _ (LibA pkgname _ way))
40 <- parsePath (parseBuildLibA root)
41 "<.a library (build) path parser>"
42 archivePath
43 let context = libAContext l
44 objs <- libraryObjects context
45 removeFile archivePath
46 build $ target context (Ar Pack stage) objs [archivePath]
47 synopsis <- pkgSynopsis (package context)
48 putSuccess $ renderLibrary
49 (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
50 archivePath synopsis
51
52 -- | Build a dynamic library ('LibDyn') under the given build root, with the
53 -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete
54 -- path of the archive to build is given as the third argument.
55 buildDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
56 buildDynamicLibUnix root suffix dynlibpath = do
57 dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
58 let context = libDynContext dynlib
59 deps <- contextDependencies context
60 need =<< mapM pkgLibraryFile deps
61
62 -- TODO should this be somewhere else?
63 -- Custom build step to generate libffi.so* in the rts build directory.
64 when (package context == rts) . interpretInContext context $ do
65 stage <- getStage
66 rtsPath <- expr (rtsBuildPath stage)
67 expr $ need ((rtsPath -/-) <$> libffiDependencies)
68
69 objs <- libraryObjects context
70 build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]
71
72 -- | Build a "GHCi library" ('LibGhci') under the given build root, with the
73 -- complete path of the file to build is given as the second argument.
74 buildGhciLibO :: FilePath -> FilePath -> Action ()
75 buildGhciLibO root ghcilibPath = do
76 l@(BuildPath _ stage _ (LibGhci _ _ _))
77 <- parsePath (parseBuildLibGhci root)
78 "<.o ghci lib (build) path parser>"
79 ghcilibPath
80 let context = libGhciContext l
81 objs <- allObjects context
82 need objs
83 build $ target context (Ld stage) objs [ghcilibPath]
84
85 -- * Helpers
86
87 -- | Return all Haskell and non-Haskell object files for the given 'Context'.
88 allObjects :: Context -> Action [FilePath]
89 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
90
91 -- | Return all the non-Haskell object files for the given library context
92 -- (object files built from C, C-- and sometimes other things).
93 nonHsObjects :: Context -> Action [FilePath]
94 nonHsObjects context = do
95 cObjs <- cObjects context
96 cmmSrcs <- interpretInContext context (getContextData cmmSrcs)
97 cmmObjs <- mapM (objectPath context) cmmSrcs
98 eObjs <- extraObjects context
99 return $ cObjs ++ cmmObjs ++ eObjs
100
101 -- | Return all the C object files needed to build the given library context.
102 cObjects :: Context -> Action [FilePath]
103 cObjects context = do
104 srcs <- interpretInContext context (getContextData cSrcs)
105 objs <- mapM (objectPath context) srcs
106 return $ if Threaded `wayUnit` way context
107 then objs
108 else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
109
110 -- | Return extra object files needed to build the given library context. The
111 -- resulting list is currently non-empty only when the package from the
112 -- 'Context' is @integer-gmp@.
113 extraObjects :: Context -> Action [FilePath]
114 extraObjects context
115 | package context == integerGmp = gmpObjects
116 | otherwise = return []
117
118 -- | Return all the object files to be put into the library we're building for
119 -- the given 'Context'.
120 libraryObjects :: Context -> Action [FilePath]
121 libraryObjects context@Context{..} = do
122 hsObjs <- hsObjects context
123 noHsObjs <- nonHsObjects context
124 need $ noHsObjs ++ hsObjs
125 return (noHsObjs ++ hsObjs)
126
127 -- * Library paths types and parsers
128
129 -- | > libHS<pkg name>-<pkg version>[_<way suffix>].a
130 data LibA = LibA String [Integer] Way deriving (Eq, Show)
131
132 -- | > <so or dylib>
133 data DynLibExt = So | Dylib deriving (Eq, Show)
134
135 -- | > libHS<pkg name>-<pkg version>[_<way suffix>]-ghc<ghc version>.<so|dylib>
136 data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show)
137
138 -- | > HS<pkg name>-<pkg version>[_<way suffix>].o
139 data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show)
140
141 -- | Get the 'Context' corresponding to the build path for a given static library.
142 libAContext :: BuildPath LibA -> Context
143 libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
144 Context stage pkg way
145 where
146 pkg = library pkgname pkgpath
147
148 -- | Get the 'Context' corresponding to the build path for a given GHCi library.
149 libGhciContext :: BuildPath LibGhci -> Context
150 libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
151 Context stage pkg way
152 where
153 pkg = library pkgname pkgpath
154
155 -- | Get the 'Context' corresponding to the build path for a given dynamic library.
156 libDynContext :: BuildPath LibDyn -> Context
157 libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
158 Context stage pkg way
159 where
160 pkg = library pkgname pkgpath
161
162 -- | Parse a path to a static library to be built, making sure the path starts
163 -- with the given build root.
164 parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
165 parseBuildLibA root = parseBuildPath root parseLibAFilename
166 Parsec.<?> "build path for a static library"
167
168 -- | Parse a path to a ghci library to be built, making sure the path starts
169 -- with the given build root.
170 parseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)
171 parseBuildLibGhci root = parseBuildPath root parseLibGhciFilename
172 Parsec.<?> "build path for a ghci library"
173
174 -- | Parse a path to a dynamic library to be built, making sure the path starts
175 -- with the given build root.
176 parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
177 parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
178 Parsec.<?> ("build path for a dynamic library with extension " ++ ext)
179
180 -- | Parse the filename of a static library to be built into a 'LibA' value.
181 parseLibAFilename :: Parsec.Parsec String () LibA
182 parseLibAFilename = do
183 _ <- Parsec.string "libHS"
184 (pkgname, pkgver) <- parsePkgId
185 way <- parseWaySuffix vanilla
186 _ <- Parsec.string ".a"
187 return (LibA pkgname pkgver way)
188
189 -- | Parse the filename of a ghci library to be built into a 'LibGhci' value.
190 parseLibGhciFilename :: Parsec.Parsec String () LibGhci
191 parseLibGhciFilename = do
192 _ <- Parsec.string "HS"
193 (pkgname, pkgver) <- parsePkgId
194 _ <- Parsec.string "."
195 way <- parseWayPrefix vanilla
196 _ <- Parsec.string "o"
197 return (LibGhci pkgname pkgver way)
198
199 -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.
200 parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn
201 parseLibDynFilename ext = do
202 _ <- Parsec.string "libHS"
203 (pkgname, pkgver) <- parsePkgId
204 way <- addWayUnit Dynamic <$> parseWaySuffix dynamic
205 _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
206 _ <- Parsec.string ("." ++ ext)
207 return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)