Commit fc564b8b authored by Andrey Mokhov's avatar Andrey Mokhov

Simplify package lists

See #403
parent f7c9b8bf
module Expression (
-- * Expressions
Expr, Predicate, Args, Ways, Packages,
Expr, Predicate, Args, Ways,
-- ** Construction and modification
expr, exprIO, arg, remove,
......@@ -40,7 +40,6 @@ type Expr a = H.Expr Context Builder a
-- and 'Packages'.
type Predicate = H.Predicate Context Builder
type Args = H.Args Context Builder
type Packages = Expr [Package]
type Ways = Expr [Way]
-- | Get a value from the @package-data.mk@ file of the current context.
......
......@@ -8,16 +8,28 @@ import Expression
-- * @Action Bool@: a flag whose value can depend on the build environment.
-- * @Predicate@: a flag whose value can depend on the build environment and
-- on the current build target.
data Flavour = Flavour
{ name :: String -- ^ Flavour name, to set from command line.
, args :: Args -- ^ Use these command line arguments.
, packages :: Packages -- ^ Build these packages.
, integerLibrary :: Action Package -- ^ Either 'integerGmp' or 'integerSimple'.
, libraryWays :: Ways -- ^ Build libraries these ways.
, rtsWays :: Ways -- ^ Build RTS these ways.
, splitObjects :: Predicate -- ^ Build split objects.
, buildHaddock :: Predicate -- ^ Build Haddock and documentation.
, dynamicGhcPrograms :: Bool -- ^ Build dynamic GHC programs.
, ghciWithDebugger :: Bool -- ^ Enable GHCi debugger.
, ghcProfiled :: Bool -- ^ Build profiled GHC.
, ghcDebugged :: Bool } -- ^ Build GHC with debug information.
data Flavour = Flavour {
-- | Flavour name, to set from command line.
name :: String,
-- | Use these command line arguments.
args :: Args,
-- | Build these packages.
packages :: Stage -> Action [Package],
-- | Either 'integerGmp' or 'integerSimple'.
integerLibrary :: Action Package,
-- | Build libraries these ways.
libraryWays :: Ways,
-- | Build RTS these ways.
rtsWays :: Ways,
-- | Build split objects.
splitObjects :: Predicate,
-- | Build Haddock and documentation.
buildHaddock :: Predicate,
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Bool,
-- | Enable GHCi debugger.
ghciWithDebugger :: Bool,
-- | Build profiled GHC.
ghcProfiled :: Bool,
-- | Build GHC with debug information.
ghcDebugged :: Bool }
......@@ -8,7 +8,7 @@ module GHC (
hpc, hpcBin, integerGmp, integerSimple, iservBin, libffi, mtl, parsec,
parallel, pretty, primitive, process, rts, runGhc, stm, templateHaskell,
terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml,
defaultKnownPackages,
defaultKnownPackages, defaultPackages,
-- * Package information
builderProvenance, programName, nonCabalContext, nonHsMainPackage, autogenPath,
......@@ -21,6 +21,7 @@ import Hadrian.Oracles.Path
import Hadrian.Oracles.TextFile
import Base
import CommandLine
import Context
import Oracles.Setting
......@@ -125,6 +126,82 @@ cUtil name = cProgram name ("utils" -/- name)
setPath :: Package -> FilePath -> Package
setPath pkg path = pkg { pkgPath = path }
-- | Packages that are built by default. You can change this in "UserSettings".
defaultPackages :: Stage -> Action [Package]
defaultPackages Stage0 = stage0Packages
defaultPackages Stage1 = stage1Packages
defaultPackages Stage2 = stage2Packages
defaultPackages Stage3 = return []
stage0Packages :: Action [Package]
stage0Packages = do
win <- windowsHost
ios <- iosHost
return $ [ binary
, cabal
, checkApiAnnotations
, compareSizes
, compiler
, deriveConstants
, dllSplit
, genapply
, genprimopcode
, ghc
, ghcBoot
, ghcBootTh
, ghcCabal
, ghci
, ghcPkg
, ghcTags
, hsc2hs
, hp2ps
, hpc
, mtl
, parsec
, templateHaskell
, text
, transformers
, unlit ]
++ [ terminfo | not win, not ios ]
++ [ touchy | win ]
stage1Packages :: Action [Package]
stage1Packages = do
win <- windowsHost
doc <- cmdBuildHaddock
intSimple <- cmdIntegerSimple
libraries0 <- filter isLibrary <$> stage0Packages
return $ libraries0 -- Build all Stage0 libraries in Stage1
++ [ array
, base
, bytestring
, containers
, deepseq
, directory
, filepath
, ghc
, ghcCabal
, ghcCompact
, ghcPrim
, haskeline
, hpcBin
, hsc2hs
, if intSimple then integerSimple else integerGmp
, pretty
, process
, rts
, runGhc
, time ]
++ [ iservBin | not win ]
++ [ unix | not win ]
++ [ win32 | win ]
++ [ xhtml | doc ]
stage2Packages :: Action [Package]
stage2Packages = do
doc <- cmdBuildHaddock
return [ haddock | doc ]
-- | Some builders are built by this very build system, in which case
-- 'builderProvenance' returns the corresponding build 'Context' (which includes
-- 'Stage' and GHC 'Package').
......
......@@ -58,7 +58,7 @@ topLevelTargets = action $ do
packageTargets :: Bool -> Stage -> Package -> Action [FilePath]
packageTargets includeGhciLib stage pkg = do
let context = vanillaContext stage pkg
activePackages <- interpretInContext context getPackages
activePackages <- stagePackages stage
if pkg `notElem` activePackages
then return [] -- Skip inactive packages.
else if isLibrary pkg
......
......@@ -119,7 +119,8 @@ haddockWrapper WrappedBinary{..} = do
iservBinWrapper :: WrappedBinary -> Expr String
iservBinWrapper WrappedBinary{..} = do
expr $ need [sourcePath -/- "Rules/Wrappers.hs"]
activePackages <- filter isLibrary <$> getPackages
stage <- getStage
activePackages <- expr $ filter isLibrary <$> stagePackages stage
-- TODO: Figure our the reason of this hardcoded exclusion
let pkgs = activePackages \\ [ cabal, process, haskeline
, terminfo, ghcCompact, hpc, compiler ]
......
module Settings (
getArgs, getPackages, getLibraryWays, getRtsWays, flavour, knownPackages,
getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
findKnownPackage, getPkgData, getPkgDataList, isLibrary, stagePackages,
builderPath, getBuilderPath, isSpecified, latestBuildStage, programPath,
programContext, integerLibraryName, getDestDir, stage1Only, buildDll0
......@@ -27,11 +27,10 @@ getLibraryWays = expr flavour >>= libraryWays
getRtsWays :: Ways
getRtsWays = expr flavour >>= rtsWays
getPackages :: Packages
getPackages = expr flavour >>= packages
stagePackages :: Stage -> Action [Package]
stagePackages stage = interpretInContext (stageContext stage) getPackages
stagePackages stage = do
f <- flavour
packages f stage
hadrianFlavours :: [Flavour]
hadrianFlavours =
......
module Settings.Default (
SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
defaultArgs, defaultPackages, defaultLibraryWays, defaultRtsWays,
defaultArgs, defaultLibraryWays, defaultRtsWays,
defaultFlavour, defaultSplitObjects
) where
......@@ -85,79 +85,6 @@ defaultSourceArgs = SourceArgs
, hsCompiler = mempty
, hsGhc = mempty }
-- | Packages that are built by default. You can change this by editing
-- 'userPackages' in "UserSettings".
defaultPackages :: Packages
defaultPackages = mconcat [ stage0 ? stage0Packages
, stage1 ? stage1Packages
, stage2 ? stage2Packages ]
stage0Packages :: Packages
stage0Packages = do
win <- expr windowsHost
ios <- expr iosHost
pure $ [ binary
, cabal
, checkApiAnnotations
, compareSizes
, compiler
, deriveConstants
, dllSplit
, genapply
, genprimopcode
, ghc
, ghcBoot
, ghcBootTh
, ghcCabal
, ghci
, ghcPkg
, ghcTags
, hsc2hs
, hp2ps
, hpc
, mtl
, parsec
, templateHaskell
, text
, transformers
, unlit ] ++
[ terminfo | not win, not ios ] ++
[ touchy | win ]
stage1Packages :: Packages
stage1Packages = do
win <- expr windowsHost
doc <- buildHaddock =<< expr flavour
intLib <- expr (integerLibrary =<< flavour)
mconcat [ (filter isLibrary) <$> stage0Packages -- Build all Stage0 libraries in Stage1
, pure $ [ array
, base
, bytestring
, containers
, deepseq
, directory
, filepath
, ghc
, ghcCabal
, ghcCompact
, ghcPrim
, haskeline
, hpcBin
, hsc2hs
, intLib
, pretty
, process
, rts
, runGhc
, time ] ++
[ iservBin | not win ] ++
[ unix | not win ] ++
[ win32 | win ] ++
[ xhtml | doc ] ]
stage2Packages :: Packages
stage2Packages = buildHaddock <$> flavour ? pure [ haddock ]
-- | Default build ways for library packages:
-- * We always build 'vanilla' way.
-- * We build 'profiling' way when stage > Stage0.
......
module Settings.Default (
SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs,
defaultArgs, defaultPackages, defaultLibraryWays, defaultRtsWays,
defaultFlavour, defaultSplitObjects
defaultArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultSplitObjects
) where
import Flavour
......@@ -16,7 +15,6 @@ data SourceArgs = SourceArgs
sourceArgs :: SourceArgs -> Args
defaultBuilderArgs, defaultPackageArgs, defaultArgs :: Args
defaultPackages :: Packages
defaultLibraryWays, defaultRtsWays :: Ways
defaultFlavour :: Flavour
defaultSplitObjects :: Predicate
......@@ -193,10 +193,11 @@ contextDependencies :: Context -> Action [Context]
contextDependencies Context {..} = case pkgCabalFile package of
Nothing -> return [] -- Non-Cabal packages have no dependencies.
Just cabalFile -> do
let pkgContext = \pkg -> Context (min stage Stage1) pkg way
let depStage = min stage Stage1
depContext = \pkg -> Context depStage pkg way
deps <- pkgDependencies cabalFile
pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
return . map pkgContext $ intersectOrd (compare . pkgName) pkgs deps
pkgs <- sort <$> stagePackages depStage
return . map depContext $ intersectOrd (compare . pkgName) pkgs deps
-- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
stage1Dependencies :: Package -> Action [Package]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment