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