Library.hs 11.3 KB
Newer Older
David Eichmann's avatar
David Eichmann committed
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
Ben Gamari's avatar
Ben Gamari committed
7

8
import Base
9
import Context
10
import Expression hiding (way, package)
11
import Oracles.ModuleFiles
12
import Packages
13
import Rules.Gmp
David Eichmann's avatar
David Eichmann committed
14
import Rules.Rts (needRtsLibffiTargets)
15
import Target
16
import Utilities
17

18
-- * Library 'Rules'
19

20 21
libraryRules :: Rules ()
libraryRules = do
22 23 24 25
    root <- buildRootRules
    root -/- "//libHS*-*.dylib"       %> buildDynamicLibUnix root "dylib"
    root -/- "//libHS*-*.so"          %> buildDynamicLibUnix root "so"
    root -/- "//*.a"                  %> buildStaticLib      root
26
    priority 2 $ do
27 28 29 30
        root -/- "stage*/lib//libHS*-*.dylib" %> registerDynamicLibUnix root "dylib"
        root -/- "stage*/lib//libHS*-*.so"    %> registerDynamicLibUnix root "so"
        root -/- "stage*/lib//*.a"            %> registerStaticLib  root
        root -/- "//HS*-*.o"   %> buildGhciLibO root
31
        root -/- "//HS*-*.p_o" %> buildGhciLibO root
Zhen Zhang's avatar
Zhen Zhang committed
32

33 34
-- * 'Action's for building libraries

35 36 37 38 39 40 41 42 43 44 45 46 47
-- | Register (with ghc-pkg) a static library ('LibA') under the given build
-- root, whose path is the second argument.
registerStaticLib :: FilePath -> FilePath -> Action ()
registerStaticLib root archivePath = do
    -- Simply need the ghc-pkg database .conf file.
    GhcPkgPath _ stage _ (LibA name version _)
        <- parsePath (parseGhcPkgLibA root)
                    "<.a library (register) path parser>"
                    archivePath
    need [ root -/- relativePackageDbPath stage
                -/- (pkgId name version) ++ ".conf"
         ]

48 49
-- | Build a static library ('LibA') under the given build root, whose path is
-- the second argument.
50 51
buildStaticLib :: FilePath -> FilePath -> Action ()
buildStaticLib root archivePath = do
52 53 54 55 56 57 58 59
    l@(BuildPath _ stage _ (LibA pkgname _ way))
        <- parsePath (parseBuildLibA root)
                     "<.a library (build) path parser>"
                     archivePath
    let context = libAContext l
    objs <- libraryObjects context
    removeFile archivePath
    build $ target context (Ar Pack stage) objs [archivePath]
60
    synopsis <- pkgSynopsis (package context)
61 62 63 64
    putSuccess $ renderLibrary
        (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
        archivePath synopsis

65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
-- | Register (with ghc-pkg) a dynamic library ('LibDyn') under the given build
-- root, with the given suffix (@.so@ or @.dylib@, @.dll@ in the future), where
-- the complete path of the registered dynamic library is given as the third
-- argument.
registerDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
registerDynamicLibUnix root suffix dynlibpath = do
    -- Simply need the ghc-pkg database .conf file.
    (GhcPkgPath _ stage _ (LibDyn name version _ _))
        <- parsePath (parseGhcPkgLibDyn root suffix)
                            "<dyn register lib parser>"
                            dynlibpath
    need [ root -/- relativePackageDbPath stage
                -/- pkgId name version ++ ".conf"
         ]

80 81 82
-- | Build a dynamic library ('LibDyn') under the given build root, with the
-- given suffix (@.so@ or @.dylib@, @.dll@ in the future), where the complete
-- path of the archive to build is given as the third argument.
83 84
buildDynamicLibUnix :: FilePath -> String -> FilePath -> Action ()
buildDynamicLibUnix root suffix dynlibpath = do
85 86 87
    dynlib <- parsePath (parseBuildLibDyn root suffix) "<dyn lib parser>" dynlibpath
    let context = libDynContext dynlib
    deps <- contextDependencies context
88
    need =<< mapM pkgRegisteredLibraryFile deps
89 90 91 92 93
    objs <- libraryObjects context
    build $ target context (Ghc LinkHs $ Context.stage context) objs [dynlibpath]

-- | Build a "GHCi library" ('LibGhci') under the given build root, with the
-- complete path of the file to build is given as the second argument.
94 95
buildGhciLibO :: FilePath -> FilePath -> Action ()
buildGhciLibO root ghcilibPath = do
96 97 98 99 100 101 102 103
    l@(BuildPath _ stage _ (LibGhci _ _ _))
        <- parsePath (parseBuildLibGhci root)
                     "<.o ghci lib (build) path parser>"
                     ghcilibPath
    let context = libGhciContext l
    objs <- allObjects context
    need objs
    build $ target context (Ld stage) objs [ghcilibPath]
104 105 106

-- * Helpers

107
-- | Return all Haskell and non-Haskell object files for the given 'Context'.
108 109 110
allObjects :: Context -> Action [FilePath]
allObjects context = (++) <$> nonHsObjects context <*> hsObjects context

111 112
-- | Return all the non-Haskell object files for the given library context
-- (object files built from C, C-- and sometimes other things).
113 114 115
nonHsObjects :: Context -> Action [FilePath]
nonHsObjects context = do
    cObjs   <- cObjects context
116
    cmmSrcs <- interpretInContext context (getContextData cmmSrcs)
117
    cmmObjs <- mapM (objectPath context) cmmSrcs
118 119 120
    eObjs   <- extraObjects context
    return $ cObjs ++ cmmObjs ++ eObjs

121
-- | Return all the C object files needed to build the given library context.
122 123
cObjects :: Context -> Action [FilePath]
cObjects context = do
124
    srcs <- interpretInContext context (getContextData cSrcs)
125
    objs <- mapM (objectPath context) srcs
126
    return $ if Threaded `wayUnit` way context
127 128
        then objs
        else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
129

130
-- | Return extra object files needed to build the given library context. The
131 132
-- resulting list is currently non-empty only when the package from the
-- 'Context' is @integer-gmp@.
133
extraObjects :: Context -> Action [FilePath]
134
extraObjects context
135 136
    | package context == integerGmp = gmpObjects
    | otherwise                     = return []
137

138 139
-- | Return all the object files to be put into the library we're building for
-- the given 'Context'.
140 141 142 143 144
libraryObjects :: Context -> Action [FilePath]
libraryObjects context@Context{..} = do
    hsObjs   <- hsObjects    context
    noHsObjs <- nonHsObjects context
    need $ noHsObjs ++ hsObjs
Ben Gamari's avatar
Ben Gamari committed
145
    return (noHsObjs ++ hsObjs)
146

David Eichmann's avatar
David Eichmann committed
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
-- | Return extra library targets.
extraTargets :: Context -> Action [FilePath]
extraTargets context
    | package context == rts  = needRtsLibffiTargets (Context.stage context)
    | otherwise               = return []

-- | Given a library 'Package' this action computes all of its targets. Needing
-- all the targets should build the library such that it is ready to be
-- registered into the package database.
-- See 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
libraryTargets :: Bool -> Context -> Action [FilePath]
libraryTargets includeGhciLib context@Context {..} = do
    libFile  <- pkgLibraryFile     context
    ghciLib  <- pkgGhciLibraryFile context
    ghci     <- if includeGhciLib && not (wayUnit Dynamic way)
                then interpretInContext context $ getContextData buildGhciLib
                else return False
    extra    <- extraTargets context
    return $ [ libFile ]
          ++ [ ghciLib | ghci ]
          ++ extra

-- | Coarse-grain 'need': make sure all given libraries are fully built.
needLibrary :: [Context] -> Action ()
needLibrary cs = need =<< concatMapM (libraryTargets True) cs

173 174 175
-- * Library paths types and parsers

-- | > 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 188

-- | Get the 'Context' corresponding to the build path for a given static library.
libAContext :: BuildPath LibA -> Context
189 190 191
libAContext (BuildPath _ stage pkgpath (LibA pkgname _ way)) =
    Context stage pkg way
  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 197 198
libGhciContext (BuildPath _ stage pkgpath (LibGhci pkgname _ way)) =
    Context stage pkg way
  where
199
    pkg = library pkgname pkgpath
200 201 202

-- | Get the 'Context' corresponding to the build path for a given dynamic library.
libDynContext :: BuildPath LibDyn -> Context
203 204 205
libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
    Context stage pkg way
  where
206
    pkg = library pkgname pkgpath
207

208 209 210 211 212 213 214 215 216 217
-- | Parse a path to a registered ghc-pkg static library to be built, making
-- sure the path starts with the given build root.
parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA)
parseGhcPkgLibA root
    = parseGhcPkgPath root
        (do -- Skip past pkgId directory.
            _ <- Parsec.manyTill Parsec.anyChar (Parsec.try $ Parsec.string "/")
            parseLibAFilename)
        Parsec.<?> "ghc-pkg path for a static library"

218
-- | Parse a path to a static library to be built, making sure the path starts
219
-- with the given build root.
220 221
parseBuildLibA :: FilePath -> Parsec.Parsec String () (BuildPath LibA)
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 227
parseBuildLibGhci :: FilePath -> Parsec.Parsec String () (BuildPath LibGhci)
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 233
parseBuildLibDyn :: FilePath -> String -> Parsec.Parsec String () (BuildPath LibDyn)
parseBuildLibDyn root ext = parseBuildPath root (parseLibDynFilename ext)
234
    Parsec.<?> ("build path for a dynamic library with extension " ++ ext)
235

236 237 238 239 240 241
-- | Parse a path to a registered ghc-pkg dynamic library, making sure the path
-- starts with the given package database root.
parseGhcPkgLibDyn :: FilePath -> String -> Parsec.Parsec String () (GhcPkgPath LibDyn)
parseGhcPkgLibDyn root ext = parseGhcPkgPath root (parseLibDynFilename ext)
    Parsec.<?> ("ghc-pkg path for a dynamic library with extension " ++ ext)

242 243 244
-- | Parse the filename of a static library to be built into a 'LibA' value.
parseLibAFilename :: Parsec.Parsec String () LibA
parseLibAFilename = do
245 246 247 248 249
    _ <- Parsec.string "libHS"
    (pkgname, pkgver) <- parsePkgId
    way <- parseWaySuffix vanilla
    _ <- Parsec.string ".a"
    return (LibA pkgname pkgver way)
250 251 252 253

-- | Parse the filename of a ghci library to be built into a 'LibGhci' value.
parseLibGhciFilename :: Parsec.Parsec String () LibGhci
parseLibGhciFilename = do
254 255
    _ <- Parsec.string "HS"
    (pkgname, pkgver) <- parsePkgId
256 257 258
    _ <- Parsec.string "."
    way <- parseWayPrefix vanilla
    _ <- Parsec.string "o"
259
    return (LibGhci pkgname pkgver way)
260 261 262 263

-- | Parse the filename of a dynamic library to be built into a 'LibDyn' value.
parseLibDynFilename :: String -> Parsec.Parsec String () LibDyn
parseLibDynFilename ext = do
264 265 266
    _ <- Parsec.string "libHS"
    (pkgname, pkgver) <- parsePkgId
    way <- addWayUnit Dynamic <$> parseWaySuffix dynamic
267
    _ <- optional $ Parsec.string "-ghc" *> parsePkgVersion
268 269
    _ <- Parsec.string ("." ++ ext)
    return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
270 271 272 273

-- | Get the package identifier given the package name and version.
pkgId :: String -> [Integer] -> String
pkgId name version = name ++ "-" ++ intercalate "." (map show version)