summaryrefslogtreecommitdiff
path: root/hadrian/src/Rules/Gmp.hs
blob: 0194518d058fde06c1fe923f34be6033dd8647e3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
module Rules.Gmp (
    gmpRules, gmpBuildPath, gmpObjects, gmpLibraryH
    ) where

import Base
import Context
import Oracles.Setting
import Packages
import Target
import Utilities

-- | Build GMP library objects and return their paths.
gmpObjects :: Action [FilePath]
gmpObjects = do
    gmpPath <- gmpBuildPath
    need [gmpPath -/- gmpLibraryH]
    -- We need to use the untracked version of 'getDirectoryFiles', because the
    -- contents of 'gmpObjectsDir' is built by Hadrian (in 'gmpRules'). Using
    -- the tracked version can lead to Shake Lint failure.
    -- See: https://ghc.haskell.org/trac/ghc/ticket/15971.
    map unifyPath <$>
        liftIO (getDirectoryFilesIO "" [gmpPath -/- gmpObjectsDir -/- "*.o"])

gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp"

gmpLibraryInTreeH :: FilePath
gmpLibraryInTreeH = "include/gmp.h"

gmpLibrary :: FilePath
gmpLibrary = ".libs/libgmp.a"

-- | GMP is considered a Stage1 package. This determines GMP build directory.
gmpContext :: Context
gmpContext = vanillaContext Stage1 integerGmp

-- TODO: Location of 'gmpBuildPath' is important: it should be outside any
-- package build directory, as otherwise GMP's object files will match build
-- patterns of 'compilePackage' rules. We could make 'compilePackage' rules
-- more precise to avoid such spurious matching.
-- | Build directory for in-tree GMP library.
gmpBuildPath :: Action FilePath
gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp")

-- | GMP library header, relative to 'gmpBuildPath'.
gmpLibraryH :: FilePath
gmpLibraryH = "include/ghc-gmp.h"

-- | Directory for GMP library object files, relative to 'gmpBuildPath'.
gmpObjectsDir :: FilePath
gmpObjectsDir = "objs"

configureEnvironment :: Action [CmdOption]
configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
                                , builderEnvironment "AR" (Ar Unpack Stage1)
                                , builderEnvironment "NM" Nm ]

gmpRules :: Rules ()
gmpRules = do
    -- Copy appropriate GMP header and object files
    root <- buildRootRules
    root <//> gmpLibraryH %> \header -> do
        windows  <- windowsHost
        configMk <- readFile' =<< (buildPath gmpContext <&> (-/- "config.mk"))
        if not windows && -- TODO: We don't use system GMP on Windows. Fix?
           any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ]
        then do
            putBuild "| GMP library/framework detected and will be used"
            copyFile (gmpBase -/- "ghc-gmp.h") header
        else do
            putBuild "| No GMP library/framework detected; in tree GMP will be built"
            gmpPath <- gmpBuildPath
            need [gmpPath -/- gmpLibrary]
            createDirectory (gmpPath -/- gmpObjectsDir)
            top <- topDirectory
            build $ target gmpContext (Ar Unpack Stage1)
                [top -/- gmpPath -/- gmpLibrary] [gmpPath -/- gmpObjectsDir]
            copyFile (gmpPath -/- "gmp.h") header
            copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH)

    -- Build in-tree GMP library, prioritised so that it matches "before"
    -- the generic .a library rule in Rules.Library, whenever applicable.
    priority 2.0 $ root <//> gmpLibrary %> \lib -> do
        gmpPath <- gmpBuildPath
        build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib]
        putSuccess "| Successfully built custom library 'gmp'"

    -- In-tree GMP header is built by the gmpLibraryH rule
    root <//> gmpLibraryInTreeH %> \_ -> do
        gmpPath <- gmpBuildPath
        need [gmpPath -/- gmpLibraryH]

    -- This causes integerGmp package to be configured, hence creating the files
    root <//> "gmp/config.mk" %> \_ -> do
        -- Calling 'need' on @setup-config@ triggers 'configurePackage'.
        -- TODO: Shall we run 'configurePackage' directly? Why this indirection?
        setupConfig <- pkgSetupConfigFile gmpContext
        need [setupConfig]

    -- TODO: Get rid of hard-coded @gmp@.
    -- Run GMP's configure script
    root <//> "gmp/Makefile" %> \mk -> do
        env     <- configureEnvironment
        gmpPath <- gmpBuildPath
        need [mk <.> "in"]
        buildWithCmdOptions env $
            target gmpContext (Configure gmpPath) [mk <.> "in"] [mk]

    -- Extract in-tree GMP sources and apply patches
    root <//> "gmp/Makefile.in" %> \_ -> do
        gmpPath <- gmpBuildPath
        removeDirectory gmpPath
        -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is
        -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
        -- That's because the doc/ directory contents are under the GFDL,
        -- which causes problems for Debian.
        tarball <- unifyPath . fromSingleton "Exactly one GMP tarball is expected"
               <$> getDirectoryFiles "" [gmpBase -/- "gmp-tarballs/gmp*.tar.bz2"]

        withTempDir $ \dir -> do
            let tmp = unifyPath dir
            need [tarball]
            build $ target gmpContext (Tar Extract) [tarball] [tmp]

            let patch     = gmpBase -/- "gmpsrc.patch"
                patchName = takeFileName patch
            copyFile patch $ tmp -/- patchName
            applyPatch tmp patchName

            let name    = dropExtension . dropExtension $ takeFileName tarball
                unpack  = fromMaybe . error $ "gmpRules: expected suffix "
                    ++ "-nodoc (found: " ++ name ++ ")."
                libName = unpack $ stripSuffix "-nodoc" name

            moveDirectory (tmp -/- libName) gmpPath