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
136
137
138
139
140
141
142
143
144
145
146
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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
{-# LANGUAGE ViewPatterns #-}
module Rules.ToolArgs(toolArgsTarget) where
import qualified Rules.Generate
import Development.Shake
import Target
import Context
import Stage
import Expression
import Packages
import Settings
import Hadrian.Oracles.Cabal
import Hadrian.Haskell.Cabal.Type
import System.Directory (canonicalizePath)
import System.Environment (lookupEnv)
import qualified Data.Set as Set
-- | @tool:@ is used by tooling in order to get the arguments necessary
-- to set up a GHC API session which can compile modules from GHC. When
-- run, the target prints out the arguments that would be passed to @ghc@
-- during normal compilation to @stdout@ for the file passed as an
-- argument.
--
-- This target is called by the `ghci.sh` script in order to load all of GHC's
-- modules into GHCi. It is invoked with argument `tool:ghc/Main.hs` in
-- that script so that we can load the whole library and executable
-- components into GHCi.
--
-- The suitable arguments for a multi-component session can be queried using
-- `multi:<pkg>`, for example `multi:ghc` will create a session which compiles the
-- `ghc` package and all it's dependencies in a single session. This is what the ./hadrian-multi
-- script uses to set-up a multi session.
--
-- The `multi` target can be used to create a session which loads **everything** that
-- can be built by stage0 compiler, this is probably more than what you need so best stick
-- with `multi:ghc` unless you're a pro.
--
-- | A phony target of form `tool:path/to/file.hs` which returns the
-- options needed to compile the specific file.
toolArgsTarget :: Rules ()
toolArgsTarget = do
phonys (\s -> if "tool:" `isPrefixOf` s then Just (toolRuleBody (drop 5 s)) else Nothing)
phonys (\s -> if "multi:" `isPrefixOf` s then Just (multiSetup (Just (drop 6 s))) else Nothing)
"multi" ~> multiSetup Nothing
multiSetup :: Maybe String -> Action ()
multiSetup pkg_s = do
-- Find the targets we want to build.
tool_targets <- case pkg_s of
Nothing -> return toolTargets
Just pkg_s -> case findPackageByName pkg_s of
Just pkg -> (pkg :) . Set.toList <$> pkg_deps pkg
Nothing -> error $ "Unknown package: " ++ pkg_s
-- Get the arguments for all the targets
pargs <- mapM one_args tool_targets
-- Build any other dependencies (such as generated files)
allDeps
liftIO $ writeOutput (concatMap (\x -> ["-unit", x]) (map ( "@" <>) pargs))
where
resp_file root p = root </> "multi" </> pkgName p
pkg_deps pkg = do
deps <- readPackageData pkg
let immediate_deps = filter (`elem` toolTargets) (packageDependencies deps)
trans_deps <- Set.unions <$> mapM pkg_deps immediate_deps
return (Set.fromList immediate_deps `Set.union` trans_deps)
one_args p = do
putProgressInfo ("Computing arguments for " ++ pkgName p)
root <- buildRoot
let fake_target = target (Context stage0InTree p (if windowsHost then vanilla else dynamic))
(Ghc ToolArgs stage0InTree) [] ["ignored"]
arg_list <- interpret fake_target getArgs
let c = (Context stage0InTree p (if windowsHost then vanilla else dynamic))
-- readContextData has the effect of configuring the package so all
-- dependent packages will also be built.
cd <- readContextData c
let rexp m = ["-reexported-module", m]
writeFile' (resp_file root p) (intercalate "\n" (th_hack arg_list
++ modules cd
++ concatMap rexp (reexportModules cd) ))
return (resp_file root p)
-- The template-haskell package is compiled with -this-unit-id=template-haskell but
-- everything which depends on it depends on `-package-id-template-haskell-2.17.0.0`
-- and so the logic for detetecting which home-units depend on what is defeated.
-- The workaround here is just to rewrite all the `-package-id` arguments to
-- point to `template-haskell` instead which works for the multi-repl case.
-- See #20887
th_hack :: [String] -> [String]
th_hack ((isPrefixOf "-package-id template-haskell" -> True) : xs) = "-package-id" : "template-haskell" : xs
th_hack (x:xs) = x : th_hack xs
th_hack [] = []
toolRuleBody :: FilePath -> Action ()
toolRuleBody fp = do
mm <- dirMap
cfp <- liftIO $ canonicalizePath fp
case find (flip isPrefixOf cfp . fst) mm of
Just (_, (p, extra)) -> mkToolTarget extra p
Nothing -> fail $ "No prefixes matched " ++ show fp ++ " IN\n " ++ show mm
writeOutput :: [String] -> IO ()
writeOutput args = do
liftIO $ lookupEnv "TOOL_OUTPUT" >>= \case
Nothing -> putStrLn (intercalate "\n" args)
Just out -> writeFile out (intercalate "\n" args)
mkToolTarget :: [String] -> Package -> Action ()
mkToolTarget es p = do
-- This builds automatically generated dependencies. Not sure how to do
-- this generically yet.
putProgressInfo ("Computing arguments for " ++ pkgName p)
allDeps
let fake_target = target (Context stage0InTree p (if windowsHost then vanilla else dynamic))
(Ghc ToolArgs stage0InTree) [] ["ignored"]
arg_list <- interpret fake_target getArgs
liftIO $ writeOutput (arg_list ++ es)
allDeps :: Action ()
allDeps = do
do
-- We can't build DLLs on Windows (yet). Actually we should only
-- include the dynamic way when we have a dynamic host GHC, but just
-- checking for Windows seems simpler for now.
let fake_target = target (Context stage0InTree compiler (if windowsHost then vanilla else dynamic))
(Ghc ToolArgs stage0InTree) [] ["ignored"]
-- need the autogenerated files so that they are precompiled
interpret fake_target Rules.Generate.compilerDependencies >>= need
root <- buildRoot
let ghc_prim = buildDir (vanillaContext stage0InTree ghcPrim)
let dir = buildDir (vanillaContext stage0InTree compiler)
need [ root -/- dir -/- "GHC" -/- "Settings" -/- "Config.hs" ]
need [ root -/- dir -/- "GHC" -/- "Parser.hs" ]
need [ root -/- dir -/- "GHC" -/- "Parser" -/- "Lexer.hs" ]
need [ root -/- dir -/- "GHC" -/- "Parser" -/- "HaddockLex.hs" ]
need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Parser.hs" ]
need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Lexer.hs" ]
need [ root -/- ghc_prim -/- "GHC" -/- "PrimopWrappers.hs" ]
-- This list is quite a lot like stage0packages but doesn't include
-- critically the `exe:ghc` component as that depends on the GHC library
-- which takes a while to compile.
toolTargets :: [Package]
toolTargets = [ binary
, bytestring
, cabalSyntax
, cabal
, compiler
, directory
, process
, exceptions
-- , ghc # depends on ghc library
-- , runGhc # depends on ghc library
, ghcBoot
, ghcBootTh
, ghcHeap
, ghci
-- , ghcPkg # executable
-- , haddock # depends on ghc library
-- , hsc2hs # executable
, hpc
-- , hpcBin # executable
, mtl
, parsec
, time
, templateHaskell
, text
, transformers
-- , unlit # executable
] ++ if windowsHost then [ win32 ] else [ unix ]
-- | Create a mapping from files to which component it belongs to.
dirMap :: Action [(FilePath, (Package, [String]))]
dirMap = do
auto <- concatMapM go toolTargets
-- Mush the ghc executable into the compiler component so the whole of ghc is not built when
-- configuring
ghc_exe <- mkGhc
return (auto ++ [ghc_exe])
where
-- Make a separate target for the exe:ghc target because otherwise
-- configuring would build the whole GHC library which we probably
-- don't want to do.
mkGhc = do
let c = (Context stage0InTree compiler (if windowsHost then vanilla else dynamic))
cd <- readContextData c
fp <- liftIO $ canonicalizePath "ghc/"
return (fp, (compiler, "-ighc" : modules cd ++ otherModules cd ++ ["ghc/Main.hs"]))
go p = do
let c = (Context stage0InTree p (if windowsHost then vanilla else dynamic))
-- readContextData has the effect of configuring the package so all
-- dependent packages will also be built.
cd <- readContextData c
ids <- liftIO $ mapM canonicalizePath [pkgPath p </> i | i <- srcDirs cd]
return $ map (,(p, modules cd ++ otherModules cd)) ids
|
