diff --git a/hadrian/ghci-cabal b/hadrian/ghci-cabal
index 28b6cfae0190d96543101daf80d0276a3ad2a21f..6250ef73f190c3ca40ea6da8260282197f296427 100755
--- a/hadrian/ghci-cabal
+++ b/hadrian/ghci-cabal
@@ -3,5 +3,5 @@
set -e
# Replace newlines with spaces, as these otherwise break the ghci invocation on windows.
-GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS | tr '\n\r' ' ')"
-ghci $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m
+GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-cabal" tool:ghc/Main.hs -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS | tr '\n\r' ' ')"
+ghci $GHC_FLAGS $@ -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m
diff --git a/hadrian/ghci-stack b/hadrian/ghci-stack
index 53fdeddad59a4fd86761bcbc7747eea655f61aba..9815879a77f9c6ebbda338259d5fabdbf96ce215 100755
--- a/hadrian/ghci-stack
+++ b/hadrian/ghci-stack
@@ -4,4 +4,4 @@ set -e
# Replace newlines with spaces, as these otherwise break the ghci invocation on windows.
GHC_FLAGS="$GHC_FLAGS $(TERM=dumb CABFLAGS=-v0 "hadrian/build-stack" tool-args -q --build-root=.hadrian_ghci --flavour=ghc-in-ghci $HADRIAN_ARGS | tr '\n\r' ' ')"
-stack exec -- ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 ghc/Main.hs +RTS -A128m
+stack exec -- ghci $GHC_FLAGS "$@" -fno-code -fwrite-interface -hidir=.hadrian_ghci/interface -O0 +RTS -A128m
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 1dc70d87283ce70e76727020442fc5f197e9881e..19ba672c0982b67105d22279373a6544bc034ea2 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -77,6 +77,7 @@ executable hadrian
, Rules.Program
, Rules.Register
, Rules.Rts
+ , Rules.ToolArgs
, Rules.Selftest
, Rules.SimpleTargets
, Rules.SourceDist
diff --git a/hadrian/hie-bios b/hadrian/hie-bios
index b6e5a471eb0bfc3f64143730cad114e1ad2afde5..4def2e8823c9e95cc4b15a96189358741b96c39d 100755
--- a/hadrian/hie-bios
+++ b/hadrian/hie-bios
@@ -3,7 +3,5 @@
# When run, this program will output a list of arguments which are necessary to
# load the GHC library component into GHCi. The program is used by `ghcide` in
# order to automatically set up the correct GHC API session for a project.
-TERM=dumb CABFLAGS=-v0 $PWD/hadrian/build-cabal tool-args -q --build-root=.hie-bios --flavour=ghc-in-ghci > $HIE_BIOS_OUTPUT
-echo -ighc >> $HIE_BIOS_OUTPUT
-echo "ghc/Main.hs" >> $HIE_BIOS_OUTPUT
+TERM=dumb CABFLAGS=-v0 $PWD/hadrian/build-cabal tool:$1 -q --build-root=.hie-bios --flavour=ghc-in-ghci > $HIE_BIOS_OUTPUT
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
index db3b16bddd82c8cab8de806d0964c737d5e1d892..eee14161cd374b30d8c30f00549cdd36ab59273a 100644
--- a/hadrian/src/Rules.hs
+++ b/hadrian/src/Rules.hs
@@ -24,43 +24,12 @@ import qualified Rules.Program
import qualified Rules.Register
import qualified Rules.Rts
import qualified Rules.SimpleTargets
+import Rules.ToolArgs
import Settings
import Settings.Program (programContext)
import Target
import UserSettings
--- | @tool-args@ 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@.
---
--- This target is called by the `ghci` script in order to load all of GHC's
--- modules into GHCi.
-toolArgsTarget :: Rules ()
-toolArgsTarget = do
- "tool-args" ~> 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 Stage0 compiler (if windowsHost then vanilla else dynamic))
- (Ghc ToolArgs Stage0) [] ["ignored"]
-
- -- need the autogenerated files so that they are precompiled
- includesDependencies Stage0 >>= need
- interpret fake_target Rules.Generate.compilerDependencies >>= need
-
- root <- buildRoot
- let dir = buildDir (vanillaContext Stage0 compiler)
- need [ root -/- dir -/- "Config.hs" ]
- need [ root -/- dir -/- "GHC" -/- "Parser.hs" ]
- need [ root -/- dir -/- "GHC" -/- "Parser" -/- "Lexer.hs" ]
- need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Parser.hs" ]
- need [ root -/- dir -/- "GHC" -/- "Cmm" -/- "Lexer.hs" ]
-
- -- Find out the arguments that are needed to load a module into the
- -- session
- arg_list <- interpret fake_target getArgs
- liftIO $ putStrLn (intercalate "\n" arg_list)
allStages :: [Stage]
allStages = [minBound .. maxBound]
diff --git a/hadrian/src/Rules/ToolArgs.hs b/hadrian/src/Rules/ToolArgs.hs
new file mode 100644
index 0000000000000000000000000000000000000000..ef75c49d15dadaeee4084c0ef16663212d9e51e3
--- /dev/null
+++ b/hadrian/src/Rules/ToolArgs.hs
@@ -0,0 +1,128 @@
+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)
+
+-- | @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.
+ allDeps
+ let fake_target = target (Context Stage0 p (if windowsHost then vanilla else dynamic))
+ (Ghc ToolArgs Stage0) [] ["ignored"]
+ arg_list <- interpret fake_target getArgs
+ liftIO $ putStrLn (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 Stage0 compiler (if windowsHost then vanilla else dynamic))
+ (Ghc ToolArgs Stage0) [] ["ignored"]
+
+ -- need the autogenerated files so that they are precompiled
+ includesDependencies Stage0 >>= need
+ interpret fake_target Rules.Generate.compilerDependencies >>= need
+
+ root <- buildRoot
+ let dir = buildDir (vanillaContext Stage0 compiler)
+ need [ root -/- dir -/- "Config.hs" ]
+ need [ root -/- dir -/- "GHC" -/- "Parser.hs" ]
+ need [ root -/- dir -/- "GHC" -/- "Parser" -/- "Lexer.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 Stage0 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 Stage0 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
+