f18832c1ef66f5cb0efdbd6d2d8265c0cc5ca0f3
[ghc.git] / hadrian / src / Settings / Builders / Ghc.hs
1 module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
2
3 import Hadrian.Haskell.Cabal
4 import Hadrian.Haskell.Cabal.Type
5
6 import Flavour
7 import Packages
8 import Settings.Builders.Common
9 import Settings.Warnings
10 import qualified Context as Context
11
12 ghcBuilderArgs :: Args
13 ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
14
15 compileAndLinkHs :: Args
16 compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
17 mconcat [ arg "-Wall"
18 , commonGhcArgs
19 , splitObjects <$> flavour ? arg "-split-objs"
20 , ghcLinkArgs
21 , defaultGhcWarningsArgs
22 , builder (Ghc CompileHs) ? arg "-c"
23 , getInputs
24 , arg "-o", arg =<< getOutput ]
25
26 compileC :: Args
27 compileC = builder (Ghc CompileCWithGhc) ? do
28 way <- getWay
29 let ccArgs = [ getContextData ccOpts
30 , getStagedSettingList ConfCcArgs
31 , cIncludeArgs
32 , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
33 mconcat [ arg "-Wall"
34 , ghcLinkArgs
35 , commonGhcArgs
36 , mconcat (map (map ("-optc" ++) <$>) ccArgs)
37 , defaultGhcWarningsArgs
38 , arg "-c"
39 , getInputs
40 , arg "-o"
41 , arg =<< getOutput ]
42
43 ghcLinkArgs :: Args
44 ghcLinkArgs = builder (Ghc LinkHs) ? do
45 pkg <- getPackage
46 libs <- getContextData extraLibs
47 libDirs <- getContextData extraLibDirs
48 fmwks <- getContextData frameworks
49 dynamic <- requiresDynamic
50 darwin <- expr osxHost
51
52 -- Relative path from the output (rpath $ORIGIN).
53 originPath <- dropFileName <$> getOutput
54 context <- getContext
55 libPath' <- expr (libPath context)
56 distDir <- expr Context.distDir
57 let
58 distPath = libPath' -/- distDir
59 originToLibsDir = makeRelativeNoSysLink originPath distPath
60 rpath | darwin = "@loader_path" -/- originToLibsDir
61 | otherwise = "$ORIGIN" -/- originToLibsDir
62
63 mconcat [ dynamic ? mconcat
64 [ arg "-dynamic"
65 -- TODO what about windows?
66 , isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ]
67 , notStage0 ?
68 hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath)
69 ]
70 , arg "-no-auto-link-packages"
71 , nonHsMainPackage pkg ? arg "-no-hs-main"
72 , not (nonHsMainPackage pkg) ? arg "-rtsopts"
73 , pure [ "-l" ++ lib | lib <- libs ]
74 , pure [ "-L" ++ libDir | libDir <- libDirs ]
75 , darwin ? pure (concat [ ["-framework", fmwk] | fmwk <- fmwks ])
76 ]
77
78 findHsDependencies :: Args
79 findHsDependencies = builder (Ghc FindHsDependencies) ? do
80 ways <- getLibraryWays
81 mconcat [ arg "-M"
82 , commonGhcArgs
83 , arg "-include-pkg-deps"
84 , arg "-dep-makefile", arg =<< getOutput
85 , pure $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
86 , getInputs ]
87
88 haddockGhcArgs :: Args
89 haddockGhcArgs = mconcat [ commonGhcArgs
90 , getContextData hcOpts
91 , ghcWarningsArgs ]
92
93 -- | Common GHC command line arguments used in 'ghcBuilderArgs',
94 -- 'ghcCBuilderArgs', 'ghcMBuilderArgs' and 'haddockGhcArgs'.
95 commonGhcArgs :: Args
96 commonGhcArgs = do
97 way <- getWay
98 path <- getBuildPath
99 ghcVersion <- expr ghcVersionH
100 mconcat [ arg "-hisuf", arg $ hisuf way
101 , arg "-osuf" , arg $ osuf way
102 , arg "-hcsuf", arg $ hcsuf way
103 , wayGhcArgs
104 , packageGhcArgs
105 , includeGhcArgs
106 -- When compiling RTS for Stage1 or Stage2 we do not have it (yet)
107 -- in the package database. We therefore explicity supply the path
108 -- to the @ghc-version@ file, to prevent GHC from trying to open the
109 -- RTS package in the package database and failing.
110 , package rts ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion)
111 , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
112 , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
113 , map ("-optP" ++) <$> getContextData cppOpts
114 , arg "-outputdir", arg path ]
115
116 -- TODO: Do '-ticky' in all debug ways?
117 wayGhcArgs :: Args
118 wayGhcArgs = do
119 way <- getWay
120 dynamic <- requiresDynamic
121 mconcat [ if dynamic
122 then pure ["-fPIC", "-dynamic"]
123 else arg "-static"
124 , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
125 , (Debug `wayUnit` way) ? arg "-optc-DDEBUG"
126 , (Profiling `wayUnit` way) ? arg "-prof"
127 , (Logging `wayUnit` way) ? arg "-eventlog"
128 , (way == debug || way == debugDynamic) ?
129 pure ["-ticky", "-DTICKY_TICKY"] ]
130
131 packageGhcArgs :: Args
132 packageGhcArgs = do
133 package <- getPackage
134 pkgId <- expr $ pkgIdentifier package
135 mconcat [ arg "-hide-all-packages"
136 , arg "-no-user-package-db"
137 , packageDatabaseArgs
138 , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
139 , map ("-package-id " ++) <$> getContextData depIds ]
140
141 includeGhcArgs :: Args
142 includeGhcArgs = do
143 pkg <- getPackage
144 path <- getBuildPath
145 root <- getBuildRoot
146 context <- getContext
147 srcDirs <- getContextData srcDirs
148 autogen <- expr $ autogenPath context
149 let cabalMacros = autogen -/- "cabal_macros.h"
150 expr $ need [cabalMacros]
151 mconcat [ arg "-i"
152 , arg $ "-i" ++ path
153 , arg $ "-i" ++ autogen
154 , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ]
155 , cIncludeArgs
156 , arg $ "-I" ++ root -/- generatedDir
157 , arg $ "-optc-I" ++ root -/- generatedDir
158 , pure ["-optP-include", "-optP" ++ cabalMacros] ]
159
160 -- Check if building dynamically is required. GHC is a special case that needs
161 -- to be built dynamically if any of the RTS ways is dynamic.
162 requiresDynamic :: Expr Bool
163 requiresDynamic = wayUnit Dynamic <$> getWay
164 -- TODO This logic has been reverted as the dynamic build is broken.
165 -- See #15837.
166 --
167 -- pkg <- getPackage
168 -- way <- getWay
169 -- rtsWays <- getRtsWays
170 -- let
171 -- dynRts = any (Dynamic `wayUnit`) rtsWays
172 -- dynWay = Dynamic `wayUnit` way
173 -- return $ if pkg == ghc
174 -- then dynRts || dynWay
175 -- else dynWay