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