Hadrian: Generate GHC wrapper scripts
[ghc.git] / hadrian / src / Rules.hs
index 852bd5d..78e3790 100644 (file)
@@ -1,4 +1,5 @@
-module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where
+module Rules (buildRules, oracleRules, packageTargets, topLevelTargets
+             , toolArgsTarget ) where
 
 import qualified Hadrian.Oracles.ArgsHash
 import qualified Hadrian.Oracles.Cabal.Rules
@@ -20,31 +21,74 @@ import qualified Rules.Libffi
 import qualified Rules.Library
 import qualified Rules.Program
 import qualified Rules.Register
+import qualified Rules.Rts
+import qualified Rules.SimpleTargets
 import Settings
 import Target
 import UserSettings
 import Utilities
 
+
+-- | @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.
+toolArgsTarget :: Rules ()
+toolArgsTarget = do
+  "tool-args" ~> do
+    let fake_target = target (Context Stage0 compiler dynamic)
+                             (Ghc ToolArgs Stage0) [] ["ignored"]
+
+    -- need the autogenerated files so that they are precompiled
+    generatedGhcDependencies 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 -/- "Fingerprint.hs" ]
+    need [ root <//> dir -/- "Parser.hs" ]
+    need [ root <//> dir -/- "Lexer.hs" ]
+    need [ root <//> dir -/- "CmmParse.hs" ]
+    need [ root <//> dir -/- "CmmLex.hs" ]
+
+    -- Find out the arguments that are needed to load a module into the
+    -- session
+    arg_list <- interpret fake_target getArgs
+    liftIO $ putStrLn (intercalate " " arg_list)
+
 allStages :: [Stage]
 allStages = [minBound .. maxBound]
 
 -- | This rule calls 'need' on all top-level build targets that Hadrian builds
--- by default, respecting the 'stage1Only' flag.
+-- by default, respecting the 'finalStage' flag.
 topLevelTargets :: Rules ()
 topLevelTargets = action $ do
     verbosity <- getVerbosity
-    when (verbosity >= Loud) $ do
-        (libraries, programs) <- partition isLibrary <$> stagePackages Stage1
-        libNames <- mapM (name Stage1) libraries
-        pgmNames <- mapM (name Stage1) programs
+    forM_ [ Stage1 ..] $ \stage -> do
+      when (verbosity >= Loud) $ do
+        (libraries, programs) <- partition isLibrary <$> stagePackages stage
+        libNames <- mapM (name stage) libraries
+        pgmNames <- mapM (name stage) programs
+        let stageHeader t ps =
+              "| Building " ++ show stage ++ " "
+                            ++ t ++ ": " ++ intercalate ", " ps
         putNormal . unlines $
-            [ "| Building Stage1 libraries: " ++ intercalate ", " libNames
-            , "| Building Stage1 programs : " ++ intercalate ", " pgmNames ]
-    let buildStages = [Stage0, Stage1] ++ [Stage2 | not stage1Only]
+            [ stageHeader "libraries" libNames
+            , stageHeader "programs" pgmNames ]
+    let buildStages = [ s | s <- [Stage0 ..], s < finalStage ]
     targets <- concatForM buildStages $ \stage -> do
         packages <- stagePackages stage
         mapM (path stage) packages
-    need targets
+
+    -- Why we need wrappers: https://gitlab.haskell.org/ghc/ghc/issues/16534.
+    root <- buildRoot
+    let wrappers = [ root -/- ("ghc-" ++ stageString s) | s <- [Stage1 ..]
+                                                        , s < finalStage ]
+    need (targets ++ wrappers)
   where
     -- either the package database config file for libraries or
     -- the programPath for programs. However this still does
@@ -77,8 +121,8 @@ packageTargets includeGhciLib stage pkg = do
             ways  <- interpretInContext context pkgWays
             libs  <- mapM (pkgLibraryFile . Context stage pkg) ways
             more  <- libraryTargets includeGhciLib context
-            setup <- pkgSetupConfigFile context
-            return $ [setup] ++ libs ++ more
+            setupConfig <- pkgSetupConfigFile context
+            return $ [setupConfig] ++ libs ++ more
         else do -- The only target of a program package is the executable.
             prgContext <- programContext stage pkg
             prgPath    <- programPath prgContext
@@ -94,33 +138,22 @@ packageRules = do
     let readPackageDb  = [(packageDb, 1)]
         writePackageDb = [(packageDb, maxConcurrentReaders)]
 
-    let contexts        = liftM3 Context        allStages knownPackages allWays
-        vanillaContexts = liftM2 vanillaContext allStages knownPackages
-
-    -- TODO: we might want to look into converting more and more
-    --       rules to the style introduced in Rules.Library in
-    --       https://github.com/snowleopard/hadrian/pull/571,
-    --       where "catch-all" rules are used to "catch" the need
-    --       for library files, and we then use parsec parsers to
-    --       extract all sorts of information needed to build them, like
-    --       the package, the stage, the way, etc.
-
-    forM_ contexts (Rules.Compile.compilePackage readPackageDb)
+    Rules.Compile.compilePackage readPackageDb
+    Rules.Dependencies.buildPackageDependencies readPackageDb
+    Rules.Documentation.buildPackageDocumentation
+    Rules.Program.buildProgramRules readPackageDb
+    Rules.Register.configurePackageRules
 
-    Rules.Program.buildProgram readPackageDb
+    forM_ [Stage0 ..] (Rules.Register.registerPackageRules writePackageDb)
 
-    forM_ [Stage0 .. ] $ \stage ->
-        -- we create a dummy context, that has the correct state, but contains
-        -- @dummyPackage@ as a... dummy package. The package isn't accessed but the record
-        -- need to be set properly. @undefined@ is not an option as it ends up
-        -- being forced.
-        Rules.Register.registerPackage writePackageDb (Context stage dummyPackage vanilla)
+    -- TODO: Can we get rid of this enumeration of contexts? Since we iterate
+    --       over it to generate all 4 types of rules below, all the time, we
+    --       might want to see whether the parse-and-extract approach of
+    --       Rules.Compile and Rules.Library could save us some time there.
+    let vanillaContexts = liftM2 vanillaContext allStages knownPackages
 
-    forM_ vanillaContexts $ mconcat
-        [ Rules.Register.configurePackage
-        , Rules.Dependencies.buildPackageDependencies readPackageDb
-        , Rules.Documentation.buildPackageDocumentation
-        , Rules.Generate.generatePackageCode ]
+    forM_ vanillaContexts Rules.Generate.generatePackageCode
+    Rules.SimpleTargets.simplePackageTargets
 
 buildRules :: Rules ()
 buildRules = do
@@ -131,6 +164,7 @@ buildRules = do
     Rules.Gmp.gmpRules
     Rules.Libffi.libffiRules
     Rules.Library.libraryRules
+    Rules.Rts.rtsRules
     packageRules
 
 oracleRules :: Rules ()