Refactor Libffi and RTS rules
[ghc.git] / hadrian / src / Rules / Library.hs
1 module Rules.Library (libraryRules, needLibrary, libraryTargets) where
2
3 import Hadrian.BuildPath
4 import Hadrian.Haskell.Cabal
5 import Hadrian.Haskell.Cabal.Type
6 import qualified Text.Parsec as Parsec
7
8 import Base
9 import Context
10 import Expression hiding (way, package)
11 import Oracles.ModuleFiles
12 import Packages
13 import Rules.Gmp
14 import Rules.Rts (needRtsLibffiTargets)
15 import Target
16 import Utilities
17
18 -- * Library 'Rules'
19
20 libraryRules :: Rules ()
21 libraryRules = do
22 root <- buildRootRules
23 root -/- "//libHS*-*.dylib" %> buildDynamicLibUnix root "dylib"
24 root -/- "//libHS*-*.so" %> buildDynamicLibUnix root "so"
25 root -/- "//*.a" %> buildStaticLib root
26 priority 2 $ do
27 root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib"
28 root -/- "stage*/lib//libHS*-*.so" %> registerDynamicLibUnix root "so"
29 root -/- "stage*/lib//*.a" %> registerStaticLib root
30 root -/- "//HS*-*.o" %> buildGhciLibO root
31 root -/- "//HS*-*.p_o" %> buildGhciLibO root
32
33 -- * 'Action's for building libraries
34
35 -- | Register (with ghc-pkg) a static library ('LibA') under the given build
36 -- root, whose path is the second argument.
37 registerStaticLib :: FilePath -> FilePath -> Action ()
38 registerStaticLib root archivePath = do
39 -- Simply need the ghc-pkg database .conf file.
40 GhcPkgPath _ stage _ (LibA name version _)
41 <- parsePath (parseGhcPkgLibA root)
42 "<.a library (register) path parser>"
43 archivePath
44 need [ root -/- relativePackageDbPath stage
45 -/- (pkgId name version) ++ ".conf"
46 ]
47
48 -- | Build a static library ('LibA') under the given build root, whose path is
49 -- the second argument.
50 buildStaticLib :: FilePath -> FilePath -> Action ()
51 buildStaticLib root archivePath = do
52 l@(BuildPath _ stage _ (LibA pkgname _ way))
53 <- parsePath (parseBuildLibA root)
54 "<.a library (build) path parser>"
55 archivePath
56 let context = libAContext l
57 objs <- libraryObjects context
58 removeFile archivePath
59 build $ target context (Ar Pack stage) objs [archivePath]
60 synopsis <- pkgSynopsis (package context)
61 putSuccess $ renderLibrary
62 (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
63 archivePath synopsis
64
65 -- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build
66 -- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where
67 -- the complete path of the registered dynamic library is given as the third
68 -- argument.
69 registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
70 registerDynamicLibUnix root suffix dynlibpath = do
71 -- Simply need the ghc-pkg database .conf file.
72 (GhcPkgPath _ stage _ (LibDyn name version _ _))
73 <- parsePath (parseGhcPkgLibDyn root suffix)
74 "<dyn register lib parser>"
75 dynlibpath
76 need [ root -/- relativePackageDbPath stage
77 -/- pkgId name version ++ ".conf"
78 ]
79
80 -- | Build a dynamic library ('LibDyn') under the given build root, with the
81 -- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete
82 -- path of the archive to build is given as the third argument.
83 buildDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
84 buildDynamicLibUnix root suffix dynlibpath = do
85 dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
86 let context = libDynContext dynlib
87 deps <- contextDependencies context
88 need =<< mapM pkgRegisteredLibraryFile deps
89 objs <- libraryObjects context
90 build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]
91
92 -- | Build a "GHCi library" ('LibGhci') under the given build root, with the
93 -- complete path of the file to build is given as the second argument.
94 buildGhciLibO :: FilePath -> FilePath -> Action ()
95 buildGhciLibO root ghcilibPath = do
96 l@(BuildPath _ stage _ (LibGhci _ _ _))
97 <- parsePath (parseBuildLibGhci root)
98 "<.o ghci lib (build) path parser>"
99 ghcilibPath
100 let context = libGhciContext l
101 objs <- allObjects context
102 need objs
103 build $ target context (Ld stage) objs [ghcilibPath]
104
105 -- * Helpers
106
107 -- | Return all Haskell and non-Haskell object files for the given 'Context'.
108 allObjects :: Context -> Action [FilePath]
109 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
110
111 -- | Return all the non-Haskell object files for the given library context
112 -- (object files built from C, C-- and sometimes other things).
113 nonHsObjects :: Context -> Action [FilePath]
114 nonHsObjects context = do
115 cObjs <- cObjects context
116 cmmSrcs <- interpretInContext context (getContextData cmmSrcs)
117 cmmObjs <- mapM (objectPath context) cmmSrcs
118 eObjs <- extraObjects context
119 return $ cObjs ++ cmmObjs ++ eObjs
120
121 -- | Return all the C object files needed to build the given library context.
122 cObjects :: Context -> Action [FilePath]
123 cObjects context = do
124 srcs <- interpretInContext context (getContextData cSrcs)
125 objs <- mapM (objectPath context) srcs
126 return $ if Threaded `wayUnit` way context
127 then objs
128 else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
129
130 -- | Return extra object files needed to build the given library context. The
131 -- resulting list is currently non-empty only when the package from the
132 -- 'Context' is @integer-gmp@.
133 extraObjects :: Context -> Action [FilePath]
134 extraObjects context
135 | package context == integerGmp = gmpObjects
136 | otherwise = return []
137
138 -- | Return all the object files to be put into the library we're building for
139 -- the given 'Context'.
140 libraryObjects :: Context -> Action [FilePath]
141 libraryObjects context@Context{..} = do
142 hsObjs <- hsObjects context
143 noHsObjs <- nonHsObjects context
144 need $ noHsObjs ++ hsObjs
145 return (noHsObjs ++ hsObjs)
146
147 -- | Return extra library targets.
148 extraTargets :: Context -> Action [FilePath]
149 extraTargets context
150 | package context == rts = needRtsLibffiTargets (Context.stage context)
151 | otherwise = return []
152
153 -- | Given a library 'Package' this action computes all of its targets. Needing
154 -- all the targets should build the library such that it is ready to be
155 -- registered into the package database.
156 -- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
157 libraryTargets :: Bool -> Context -> Action [FilePath]
158 libraryTargets includeGhciLib context@Context {..} = do
159 libFile <- pkgLibraryFile context
160 ghciLib <- pkgGhciLibraryFile context
161 ghci <- if includeGhciLib && not (wayUnit Dynamic way)
162 then interpretInContext context $ getContextData buildGhciLib
163 else return False
164 extra <- extraTargets context
165 return $ [ libFile ]
166 ++ [ ghciLib | ghci ]
167 ++ extra
168
169 -- | Coarse-grain 'need': make sure all given libraries are fully built.
170 needLibrary :: [Context] -> Action ()
171 needLibrary cs = need =<< concatMapM (libraryTargets True) cs
172
173 -- * Library paths types and parsers
174
175 -- | > libHS<pkg name>-<pkg version>[_<way suffix>].a
176 data LibA = LibA String [Integer] Way deriving (Eq, Show)
177
178 -- | > <so or dylib>
179 data DynLibExt = So | Dylib deriving (Eq, Show)
180
181 -- | > libHS<pkg name>-<pkg version>[_<way suffix>]-ghc<ghc version>.<so|dylib>
182 data LibDyn = LibDyn String [Integer] Way DynLibExt deriving (Eq, Show)
183
184 -- | > HS<pkg name>-<pkg version>[_<way suffix>].o
185 data LibGhci = LibGhci String [Integer] Way deriving (Eq, Show)
186
187 -- | Get the 'Context' corresponding to the build path for a given static library.
188 libAContext :: BuildPath LibA -> Context
189 libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
190 Context stage pkg way
191 where
192 pkg = library pkgname pkgpath
193
194 -- | Get the 'Context' corresponding to the build path for a given GHCi library.
195 libGhciContext :: BuildPath LibGhci -> Context
196 libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
197 Context stage pkg way
198 where
199 pkg = library pkgname pkgpath
200
201 -- | Get the 'Context' corresponding to the build path for a given dynamic library.
202 libDynContext :: BuildPath LibDyn -> Context
203 libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
204 Context stage pkg way
205 where
206 pkg = library pkgname pkgpath
207
208 -- | Parse a path to a registered ghc-pkg static library to be built, making
209 -- sure the path starts with the given build root.
210 parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA)
211 parseGhcPkgLibA root
212 = parseGhcPkgPath root
213 (do -- Skip past pkgId directory.
214 _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/")
215 parseLibAFilename)
216 Parsec.<?> "ghc-pkg path for a static library"
217
218 -- | Parse a path to a static library to be built, making sure the path starts
219 -- with the given build root.
220 parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
221 parseBuildLibA root = parseBuildPath root parseLibAFilename
222 Parsec.<?> "build path for a static library"
223
224 -- | Parse a path to a ghci library to be built, making sure the path starts
225 -- with the given build root.
226 parseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)
227 parseBuildLibGhci root = parseBuildPath root parseLibGhciFilename
228 Parsec.<?> "build path for a ghci library"
229
230 -- | Parse a path to a dynamic library to be built, making sure the path starts
231 -- with the given build root.
232 parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
233 parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
234 Parsec.<?> ("build path for a dynamic library with extension " ++ ext)
235
236 -- | Parse a path to a registered ghc-pkg dynamic library, making sure the path
237 -- starts with the given package database root.
238 parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn)
239 parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext)
240 Parsec.<?> ("ghc-pkg path for a dynamic library with extension " ++ ext)
241
242 -- | Parse the filename of a static library to be built into a 'LibA' value.
243 parseLibAFilename :: Parsec.Parsec String () LibA
244 parseLibAFilename = do
245 _ <- Parsec.string "libHS"
246 (pkgname, pkgver) <- parsePkgId
247 way <- parseWaySuffix vanilla
248 _ <- Parsec.string ".a"
249 return (LibA pkgname pkgver way)
250
251 -- | Parse the filename of a ghci library to be built into a 'LibGhci' value.
252 parseLibGhciFilename :: Parsec.Parsec String () LibGhci
253 parseLibGhciFilename = do
254 _ <- Parsec.string "HS"
255 (pkgname, pkgver) <- parsePkgId
256 _ <- Parsec.string "."
257 way <- parseWayPrefix vanilla
258 _ <- Parsec.string "o"
259 return (LibGhci pkgname pkgver way)
260
261 -- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.
262 parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn
263 parseLibDynFilename ext = do
264 _ <- Parsec.string "libHS"
265 (pkgname, pkgver) <- parsePkgId
266 way <- addWayUnit Dynamic <$> parseWaySuffix dynamic
267 _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
268 _ <- Parsec.string ("." ++ ext)
269 return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
270
271 -- | Get the package identifier given the package name and version.
272 pkgId :: String -> [Integer] -> String
273 pkgId name version = name ++ "-" ++ intercalate "." (map show version)