From 2eda7754512b70601f2daeb0ee0f1689763a61ff Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 18 Mar 2020 15:25:41 +0000 Subject: WIP: Generalise hadrian to work with multi-component --- hadrian/hadrian.cabal | 1 + hadrian/hie-bios | 4 +- hadrian/src/Rules.hs | 33 +---------- hadrian/src/Rules/ToolArgs.hs | 111 +++++++++++++++++++++++++++++++++++ hadrian/src/Settings/Builders/Ghc.hs | 7 ++- 5 files changed, 119 insertions(+), 37 deletions(-) create mode 100644 hadrian/src/Rules/ToolArgs.hs diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal index dd95e88299..01e4c46878 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 b6e5a471eb..4def2e8823 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 f479ba679f..eee14161cd 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 -/- "Parser.hs" ] - need [ root -/- dir -/- "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 0000000000..1935174f9d --- /dev/null +++ b/hadrian/src/Rules/ToolArgs.hs @@ -0,0 +1,111 @@ +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-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.sh` script in order to load all of GHC's +-- modules into GHCi. +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 -/- "Parser.hs" ] + need [ root -/- dir -/- "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 + + +toolTargets :: [Package] +toolTargets = [ array + , bytestring + , templateHaskell + , containers + , deepseq + , directory + , exceptions + , filepath + , compiler + , ghcCompact + , ghcPrim + --, haskeline + , hp2ps + , hsc2hs + , pretty + , process + , rts + , stm + , time + , unlit + , xhtml ] + +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 + manual <- mkGhc + return (auto ++ [manual]) + + where + 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)) + cd <- readContextData c + ids <- liftIO $ mapM canonicalizePath [pkgPath p i | i <- srcDirs cd] + return $ map (,(p, modules cd ++ otherModules cd)) ids + +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 + 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)) + + diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs index 2549a63e39..d498a6236c 100644 --- a/hadrian/src/Settings/Builders/Ghc.hs +++ b/hadrian/src/Settings/Builders/Ghc.hs @@ -13,6 +13,7 @@ import Settings.Builders.Common import Settings.Warnings import qualified Context as Context import Rules.Libffi (libffiName) +import System.Directory ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [ compileAndLinkHs, compileC, findHsDependencies @@ -215,17 +216,19 @@ includeGhcArgs :: Args includeGhcArgs = do pkg <- getPackage path <- getBuildPath + cpath <- exprIO $ canonicalizePath path context <- getContext srcDirs <- getContextData srcDirs + abSrcDirs <- exprIO $ mapM canonicalizePath [pkgPath pkg -/- dir | dir <- srcDirs ] autogen <- expr $ autogenPath context stage <- getStage libPath <- expr $ stageLibPath stage let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ arg "-i" - , arg $ "-i" ++ path + , arg $ "-i" ++ cpath , arg $ "-i" ++ autogen - , pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ] + , pure [ "-i" ++ d | d <- abSrcDirs ] , cIncludeArgs , arg $ "-I" ++ libPath , arg $ "-optc-I" ++ libPath -- cgit v1.2.1