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
|
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)
-- | @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.
--
-- In the future where we have multi-component ghci this code can be
-- modified to supply the right arguments for that. At the moment it is
-- also used for GHC's support for multi-component ghcide (see the
-- `hadrian/hie-bios` script).
-- | 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)
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
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 $ lookupEnv "TOOL_OUTPUT" >>= \case
Nothing -> putStrLn (intercalate "\n" (arg_list ++ es))
Just out -> writeFile out (intercalate "\n" (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 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" ]
-- 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 = [ array
, bytestring
, templateHaskell
, containers
, deepseq
, directory
, exceptions
, filepath
, compiler
, ghcCompact
, ghcPrim
--, haskeline
, hp2ps
, hsc2hs
, pretty
, process
, rts
, stm
, time
, unlit
, xhtml ]
-- | 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
|
