Refactor Libffi and RTS rules
[ghc.git] / hadrian / src / Rules / Libffi.hs
1 {-# LANGUAGE TypeFamilies #-}
2
3 module Rules.Libffi (
4 LibffiDynLibs(..),
5 needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles,
6 libffiHeaders, libffiSystemHeaders, libffiName
7 ) where
8
9 import Hadrian.Utilities
10
11 import Packages
12 import Settings.Builders.Common
13 import Target
14 import Utilities
15
16 -- | Oracle question type. The oracle returns the list of dynamic
17 -- libffi library file paths (all but one of which should be symlinks).
18 newtype LibffiDynLibs = LibffiDynLibs Stage
19 deriving (Eq, Show, Hashable, Binary, NFData)
20 type instance RuleResult LibffiDynLibs = [FilePath]
21
22 askLibffilDynLibs :: Stage -> Action [FilePath]
23 askLibffilDynLibs stage = askOracle (LibffiDynLibs stage)
24
25 -- | The path to the dynamic library manifest file. The file contains all file
26 -- paths to libffi dynamic library file paths.
27 dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath
28 dynLibManifest' getRoot stage = do
29 root <- getRoot
30 return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs"
31
32 dynLibManifestRules :: Stage -> Rules FilePath
33 dynLibManifestRules = dynLibManifest' buildRootRules
34
35 dynLibManifest :: Stage -> Action FilePath
36 dynLibManifest = dynLibManifest' buildRoot
37
38 -- | Need the (locally built) libffi library.
39 needLibffi :: Stage -> Action ()
40 needLibffi stage = do
41 manifest <- dynLibManifest stage
42 need [manifest]
43
44 -- | Context for @libffi@.
45 libffiContext :: Stage -> Action Context
46 libffiContext stage = do
47 ways <- interpretInContext
48 (Context stage libffi (error "libffiContext: way not set"))
49 getLibraryWays
50 return . Context stage libffi $ if any (wayUnit Dynamic) ways
51 then dynamic
52 else vanilla
53
54 -- | The name of the (locally built) library
55 libffiName :: Expr String
56 libffiName = do
57 windows <- expr windowsHost
58 way <- getWay
59 return $ libffiName' windows (Dynamic `wayUnit` way)
60
61 -- | The name of the (locally built) library
62 libffiName' :: Bool -> Bool -> String
63 libffiName' windows dynamic
64 = (if dynamic then "" else "C")
65 ++ (if windows then "ffi-6" else "ffi")
66
67 libffiLibrary :: FilePath
68 libffiLibrary = "inst/lib/libffi.a"
69
70 libffiHeaderFiles :: [FilePath]
71 libffiHeaderFiles = ["ffi.h", "ffitarget.h"]
72
73 libffiHeaders :: Stage -> Action [FilePath]
74 libffiHeaders stage = do
75 path <- libffiBuildPath stage
76 return $ fmap ((path -/- "inst/include") -/-) libffiHeaderFiles
77
78 libffiSystemHeaders :: Action [FilePath]
79 libffiSystemHeaders = do
80 ffiIncludeDir <- setting FfiIncludeDir
81 return $ fmap (ffiIncludeDir -/-) libffiHeaderFiles
82
83 fixLibffiMakefile :: FilePath -> String -> String
84 fixLibffiMakefile top =
85 replace "-MD" "-MMD"
86 . replace "@toolexeclibdir@" "$(libdir)"
87 . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
88
89 -- TODO: check code duplication w.r.t. ConfCcArgs
90 configureEnvironment :: Stage -> Action [CmdOption]
91 configureEnvironment stage = do
92 context <- libffiContext stage
93 cFlags <- interpretInContext context $ mconcat
94 [ cArgs
95 , getStagedSettingList ConfCcArgs ]
96 ldFlags <- interpretInContext context ldArgs
97 sequence [ builderEnvironment "CC" $ Cc CompileC stage
98 , builderEnvironment "CXX" $ Cc CompileC stage
99 , builderEnvironment "LD" (Ld stage)
100 , builderEnvironment "AR" (Ar Unpack stage)
101 , builderEnvironment "NM" Nm
102 , builderEnvironment "RANLIB" Ranlib
103 , return . AddEnv "CFLAGS" $ unwords cFlags ++ " -w"
104 , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
105
106 libffiRules :: Rules ()
107 libffiRules = do
108 _ <- addOracleCache $ \ (LibffiDynLibs stage)
109 -> readFileLines =<< dynLibManifest stage
110 forM_ [Stage1 ..] $ \stage -> do
111 root <- buildRootRules
112 let path = root -/- stageString stage
113 libffiPath = path -/- pkgName libffi -/- "build"
114
115 -- We set a higher priority because this rule overlaps with the build rule
116 -- for static libraries 'Rules.Library.libraryRules'.
117 dynLibMan <- dynLibManifestRules stage
118 let topLevelTargets = [ libffiPath -/- libffiLibrary
119 , dynLibMan
120 ]
121 priority 2 $ topLevelTargets &%> \_ -> do
122 context <- libffiContext stage
123
124 -- Note this build needs the Makefile, triggering the rules bellow.
125 build $ target context (Make libffiPath) [] []
126
127 -- Find dynamic libraries.
128 dynLibFiles <- do
129 windows <- windowsHost
130 osx <- osxHost
131 let libffiName'' = libffiName' windows True
132 if windows
133 then
134 let libffiDll = "lib" ++ libffiName'' ++ ".dll"
135 in return [libffiPath -/- "inst/bin" -/- libffiDll]
136 else do
137 let libffiLibPath = libffiPath -/- "inst/lib"
138 dynLibsRelative <- liftIO $ getDirectoryFilesIO
139 libffiLibPath
140 (if osx
141 then ["lib" ++ libffiName'' ++ ".dylib*"]
142 else ["lib" ++ libffiName'' ++ ".so*"])
143 return (fmap (libffiLibPath -/-) dynLibsRelative)
144
145 writeFileLines dynLibMan dynLibFiles
146 putSuccess "| Successfully build libffi."
147
148 fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do
149 -- Extract libffi tar file
150 context <- libffiContext stage
151 removeDirectory libffiPath
152 top <- topDirectory
153 tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected"
154 <$> getDirectoryFiles top ["libffi-tarballs/libffi*.tar.gz"]
155
156 need [top -/- tarball]
157 -- Go from 'libffi-3.99999+git20171002+77e130c.tar.gz' to 'libffi-3.99999'
158 let libname = takeWhile (/= '+') $ takeFileName tarball
159
160 -- Move extracted directory to libffiPath.
161 root <- buildRoot
162 removeDirectory (root -/- libname)
163 actionFinally (do
164 build $ target context (Tar Extract) [tarball] [path]
165 moveDirectory (path -/- libname) libffiPath) $
166 -- And finally:
167 removeFiles (path) [libname <//> "*"]
168
169 fixFile mkIn (fixLibffiMakefile top)
170
171 files <- liftIO $ getDirectoryFilesIO "." [libffiPath <//> "*"]
172 produces files
173
174 fmap (libffiPath -/-) ["Makefile", "config.guess", "config.sub"] &%> \[mk, _, _] -> do
175 context <- libffiContext stage
176
177 -- This need rule extracts the libffi tar file to libffiPath.
178 need [mk <.> "in"]
179
180 -- Configure.
181 forM_ ["config.guess", "config.sub"] $ \file -> do
182 copyFile file (libffiPath -/- file)
183 env <- configureEnvironment stage
184 buildWithCmdOptions env $
185 target context (Configure libffiPath) [mk <.> "in"] [mk]
186
187 dir <- setting BuildPlatform
188 files <- liftIO $ getDirectoryFilesIO "." [libffiPath -/- dir <//> "*"]
189 produces files