[commit: ghc] master: Fix defaut top level targets (#659) (8ec50a5)
git at git.haskell.org
git at git.haskell.org
Tue Oct 23 20:19:09 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/8ec50a585ac62cf7eaa1d4be16a26a2e2990226f/ghc
>---------------------------------------------------------------
commit 8ec50a585ac62cf7eaa1d4be16a26a2e2990226f
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Mon Aug 27 01:31:22 2018 +0100
Fix defaut top level targets (#659)
* Keep only Stage0 and Stage1 package databases
* Fix default top-level targets
>---------------------------------------------------------------
8ec50a585ac62cf7eaa1d4be16a26a2e2990226f
src/Base.hs | 6 +++---
src/GHC.hs | 32 ++++++++++++++++----------------
src/Rules.hs | 35 ++++++++++++++++++-----------------
src/Rules/Register.hs | 6 +++---
src/UserSettings.hs | 11 ++++-------
5 files changed, 44 insertions(+), 46 deletions(-)
diff --git a/src/Base.hs b/src/Base.hs
index 32fb979..68862ed 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -82,10 +82,10 @@ generatedDir = "generated"
generatedPath :: Action FilePath
generatedPath = buildRoot <&> (-/- generatedDir)
--- | Path to the package database for the given stage of GHC,
--- relative to the build root.
+-- | Path to the package database for a given build stage, relative to the build
+-- root. Note that @StageN@, where @N > 1@, uses the 'Stage1' package database.
relativePackageDbPath :: Stage -> FilePath
-relativePackageDbPath stage = stageString stage -/- "lib" -/- "package.conf.d"
+relativePackageDbPath stage = stageString (min stage Stage1) -/- "lib/package.conf.d"
-- | Path to the package database used in a given 'Stage', including
-- the build root.
diff --git a/src/GHC.hs b/src/GHC.hs
index c5fd1a3..a849294 100644
--- a/src/GHC.hs
+++ b/src/GHC.hs
@@ -51,9 +51,7 @@ stage0Packages = do
, ghcHeap
, ghci
, ghcPkg
- , ghcTags
, hsc2hs
- , hp2ps
, hpc
, mtl
, parsec
@@ -92,31 +90,33 @@ stage1Packages = do
, time
, unlit
, xhtml ]
- ++ [ haddock | not cross ]
- ++ [ runGhc | not cross ]
++ [ hpcBin | not cross ]
++ [ iserv | not win, not cross ]
++ [ libiserv | not win, not cross ]
+ ++ [ runGhc | not cross ]
+ ++ [ touchy | win ]
++ [ unix | not win ]
++ [ win32 | win ]
stage2Packages :: Action [Package]
-stage2Packages = return [haddock]
+stage2Packages = do
+ cross <- flag CrossCompiling
+ return $ [ ghcTags ]
+ ++ [ haddock | not cross ]
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = do
- win <- windowsHost
- return $
- [ checkApiAnnotations
- , checkPpr
- , ghci
- , ghcPkg
- , hp2ps
- , iserv
- , parallel
- , runGhc ] ++
- [ timeout | win ]
+ win <- windowsHost
+ return $ [ checkApiAnnotations
+ , checkPpr
+ , ghci
+ , ghcPkg
+ , hp2ps
+ , iserv
+ , parallel
+ , runGhc ] ++
+ [ timeout | win ]
-- | Given a 'Context', compute the name of the program that is built in it
-- assuming that the corresponding package's type is 'Program'. For example, GHC
diff --git a/src/Rules.hs b/src/Rules.hs
index 93b8592..85eb001 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -21,39 +21,40 @@ import qualified Rules.Program
import qualified Rules.Register
import Settings
import Target
+import UserSettings
import Utilities
allStages :: [Stage]
allStages = [minBound .. maxBound]
--- | This rule calls 'need' on all top-level build targets, respecting the
--- 'Stage1Only' flag.
+-- | This rule calls 'need' on all top-level build targets that Hadrian builds
+-- by default, respecting the 'stage1Only' flag.
topLevelTargets :: Rules ()
topLevelTargets = action $ do
- (programs, libraries) <- partition isProgram <$> stagePackages Stage1
- pgmNames <- mapM (g Stage1) programs
- libNames <- mapM (g Stage1) libraries
-
verbosity <- getVerbosity
when (verbosity >= Loud) $ do
- putNormal "Building stage2"
+ (libraries, programs) <- partition isLibrary <$> stagePackages Stage1
+ libNames <- mapM (name Stage1) libraries
+ pgmNames <- mapM (name Stage1) programs
putNormal . unlines $
- [ "| Building Programs : " ++ intercalate ", " pgmNames
- , "| Building Libraries: " ++ intercalate ", " libNames ]
-
- targets <- mapM (f Stage1) =<< stagePackages Stage1
+ [ "| Building Stage1 libraries: " ++ intercalate ", " libNames
+ , "| Building Stage1 programs : " ++ intercalate ", " pgmNames ]
+ let buildStages = [Stage0, Stage1] ++ [Stage2 | not stage1Only]
+ targets <- concatForM buildStages $ \stage -> do
+ packages <- stagePackages stage
+ mapM (path stage) packages
need targets
where
-- either the package database config file for libraries or
-- the programPath for programs. However this still does
-- not support multiple targets, where a cabal package has
-- a library /and/ a program.
- f :: Stage -> Package -> Action FilePath
- f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v"))
- | otherwise = programPath =<< programContext stage pkg
- g :: Stage -> Package -> Action String
- g stage pkg | isLibrary pkg = return $ pkgName pkg
- | otherwise = programName (Context stage pkg (read "v"))
+ path :: Stage -> Package -> Action FilePath
+ path stage pkg | isLibrary pkg = pkgConfFile (vanillaContext stage pkg)
+ | otherwise = programPath =<< programContext stage pkg
+ name :: Stage -> Package -> Action String
+ name stage pkg | isLibrary pkg = return (pkgName pkg)
+ | otherwise = programName (vanillaContext stage pkg)
-- TODO: Get rid of the @includeGhciLib@ hack.
-- | Return the list of targets associated with a given 'Stage' and 'Package'.
diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs
index 7aa1ca4..909b1b3 100644
--- a/src/Rules/Register.hs
+++ b/src/Rules/Register.hs
@@ -28,10 +28,10 @@ configurePackage context at Context {..} = do
root -/- contextDir context -/- "setup-config" %> \_ ->
Cabal.configurePackage context
--- | Registering a package and initialise the corresponding package database if
--- need be.
+-- | Register a package and initialise the corresponding package database if
+-- need be. Note that we only register packages in 'Stage0' and 'Stage1'.
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
-registerPackage rs context at Context {..} = do
+registerPackage rs context at Context {..} = when (stage < Stage2) $ do
root <- buildRootRules
-- Initialise the package database.
diff --git a/src/UserSettings.hs b/src/UserSettings.hs
index e52ed68..9246806 100644
--- a/src/UserSettings.hs
+++ b/src/UserSettings.hs
@@ -3,8 +3,8 @@
-- If you don't copy the file your changes will be tracked by git and you can
-- accidentally commit them.
module UserSettings (
- userFlavours, userPackages, verboseCommand,
- buildProgressColour, successColour, stage1Only
+ userFlavours, userPackages, verboseCommand, buildProgressColour,
+ successColour, stage1Only
) where
import Flavour
@@ -46,11 +46,8 @@ successColour :: SuccessColour
successColour = mkSuccessColour (Dull Green)
-- TODO: Set this flag from the command line.
--- | Set this flag to 'True' to disable building Stage2 GHC (i.e. the @ghc-stage2@
--- executable) and Stage2 utilities (such as @haddock@). Note that all Stage0
--- and Stage1 libraries (including 'compiler') will still be built. Enabling
--- this flag during installation leads to installing @ghc-stage1@ instead of
--- @ghc-stage2@, and @ghc-pkg@ that was build with the Stage0 compiler.
+-- | Set this flag to 'True' to disable building Stage2 GHC and Stage2 utilities
+-- such as @haddock at . All Stage0 and Stage1 libraries will still be built.
-- Also see Note [No stage2 packages when CrossCompiling or Stage1Only] in the
-- top-level @ghc.mk at .
stage1Only :: Bool
More information about the ghc-commits
mailing list