Library.hs 3.66 KB
Newer Older
Zhen Zhang's avatar
Zhen Zhang committed
1
module Rules.Library (
Andrey Mokhov's avatar
Andrey Mokhov committed
2
    buildPackageLibrary, buildPackageGhciLibrary, buildDynamicLib
Zhen Zhang's avatar
Zhen Zhang committed
3
) where
4

Ben Gamari's avatar
Ben Gamari committed
5
import Data.Char
6
import qualified System.Directory as IO
Ben Gamari's avatar
Ben Gamari committed
7

8
import Base
9
import Context
10
import Expression hiding (way, package)
Andrey Mokhov's avatar
Andrey Mokhov committed
11
import Flavour
Andrey Mokhov's avatar
Andrey Mokhov committed
12
import GHC
13
import Oracles.ModuleFiles
Andrey Mokhov's avatar
Andrey Mokhov committed
14
import Oracles.PackageData
15
import Oracles.Setting
16
import Settings
17
import Settings.Path
18
import Target
Andrey Mokhov's avatar
Andrey Mokhov committed
19
import UserSettings
20
import Utilities
21

Andrey Mokhov's avatar
Andrey Mokhov committed
22 23
libraryObjects :: Context -> Action [FilePath]
libraryObjects context@Context{..} = do
Zhen Zhang's avatar
Zhen Zhang committed
24 25 26 27 28 29 30 31 32
    hsObjs   <- hsObjects    context
    noHsObjs <- nonHsObjects context

    -- This will create split objects if required (we don't track them
    -- explicitly as this would needlessly bloat the Shake database).
    need $ noHsObjs ++ hsObjs

    split <- interpretInContext context $ splitObjects flavour
    let getSplitObjs = concatForM hsObjs $ \obj -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
33 34 35
            let dir = dropExtension obj ++ "_" ++ osuf way ++ "_split"
            contents <- liftIO $ IO.getDirectoryContents dir
            return . map (dir -/-) $ filter (not . all (== '.')) contents
Zhen Zhang's avatar
Zhen Zhang committed
36 37 38 39 40

    (noHsObjs ++) <$> if split then getSplitObjs else return hsObjs

buildDynamicLib :: Context -> Rules ()
buildDynamicLib context@Context{..} = do
Andrey Mokhov's avatar
Andrey Mokhov committed
41
    let libPrefix = buildPath context -/- "libHS" ++ pkgNameString package
Andrey Mokhov's avatar
Andrey Mokhov committed
42
    -- OS X
Andrey Mokhov's avatar
Andrey Mokhov committed
43
    libPrefix ++ "*.dylib" %> buildDynamicLibUnix
Zhen Zhang's avatar
Zhen Zhang committed
44
    -- Linux
Andrey Mokhov's avatar
Andrey Mokhov committed
45
    libPrefix ++ "*.so"    %> buildDynamicLibUnix
Zhen Zhang's avatar
Zhen Zhang committed
46 47
    -- TODO: Windows
  where
Andrey Mokhov's avatar
Andrey Mokhov committed
48
    buildDynamicLibUnix lib = do
Zhen Zhang's avatar
Zhen Zhang committed
49
        deps <- contextDependencies context
Andrey Mokhov's avatar
Andrey Mokhov committed
50 51
        need =<< mapM pkgLibraryFile deps
        objs <- libraryObjects context
Andrey Mokhov's avatar
Andrey Mokhov committed
52
        build $ target context (Ghc LinkHs stage) objs [lib]
Zhen Zhang's avatar
Zhen Zhang committed
53

54
buildPackageLibrary :: Context -> Rules ()
55
buildPackageLibrary context@Context {..} = do
Andrey Mokhov's avatar
Andrey Mokhov committed
56
    let libPrefix  = buildPath context -/- "libHS" ++ pkgNameString package
57
    matchVersionedFilePath libPrefix (waySuffix way <.> "a") ?> \a -> do
Andrey Mokhov's avatar
Andrey Mokhov committed
58
        objs <- libraryObjects context
59
        asuf <- libsuf way
60
        let isLib0 = ("//*-0" ++ asuf) ?== a
Andrey Mokhov's avatar
Andrey Mokhov committed
61
        removeFile a
62 63
        if isLib0 then build $ target context (Ar stage) []   [a] -- TODO: Scan for dlls
                  else build $ target context (Ar stage) objs [a]
64

65
        synopsis <- interpretInContext context $ getPkgData Synopsis
Moritz Angermann's avatar
Moritz Angermann committed
66
        unless isLib0 . putSuccess $ renderLibrary
67 68
            (quote (pkgNameString package) ++ " (" ++ show stage ++ ", way "
            ++ show way ++ ").") a (dropWhileEnd isPunctuation synopsis)
69

70
buildPackageGhciLibrary :: Context -> Rules ()
71
buildPackageGhciLibrary context@Context {..} = priority 2 $ do
72
    let libPrefix = buildPath context -/- "HS" ++ pkgNameString package
73
    matchVersionedFilePath libPrefix (waySuffix way <.> "o") ?> \obj -> do
74
        objs <- allObjects context
Andrey Mokhov's avatar
Andrey Mokhov committed
75
        need objs
76
        build $ target context Ld objs [obj]
Andrey Mokhov's avatar
Andrey Mokhov committed
77

78 79 80 81 82 83 84 85 86 87 88
allObjects :: Context -> Action [FilePath]
allObjects context = (++) <$> nonHsObjects context <*> hsObjects context

nonHsObjects :: Context -> Action [FilePath]
nonHsObjects context = do
    let path = buildPath context
    cObjs   <- cObjects context
    cmmObjs <- map (objectPath context) <$> pkgDataList (CmmSrcs path)
    eObjs   <- extraObjects context
    return $ cObjs ++ cmmObjs ++ eObjs

89 90 91 92 93 94
cObjects :: Context -> Action [FilePath]
cObjects context = do
    objs <- map (objectPath context) <$> pkgDataList (CSrcs $ buildPath context)
    return $ if way context == threaded
        then objs
        else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
95

96
extraObjects :: Context -> Action [FilePath]
97
extraObjects context
Andrey Mokhov's avatar
Andrey Mokhov committed
98
    | package context == integerGmp = do
Andrey Mokhov's avatar
Andrey Mokhov committed
99
        need [gmpLibraryH]
100
        map unifyPath <$> getDirectoryFiles "" [gmpObjects -/- "*.o"]
101
    | otherwise         = return []