Simplify package lists
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 27 Aug 2017 02:08:20 +0000 (03:08 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 27 Aug 2017 02:08:20 +0000 (03:08 +0100)
See #403

src/Expression.hs
src/Flavour.hs
src/GHC.hs
src/Rules.hs
src/Rules/Wrappers.hs
src/Settings.hs
src/Settings/Default.hs
src/Settings/Default.hs-boot
src/Utilities.hs

index 647c057..5daaa21 100644 (file)
@@ -1,6 +1,6 @@
 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.
index 737b201..31772ca 100644 (file)
@@ -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 }
index 7ed96d2..8b7fdb8 100644 (file)
@@ -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').
index 61edaf2..3131105 100644 (file)
@@ -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
index d6eeb1b..ae05ca7 100644 (file)
@@ -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 ]
index 52c36ad..8056851 100644 (file)
@@ -1,5 +1,5 @@
 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 =
index d28df6c..92a6cbf 100644 (file)
@@ -1,6 +1,6 @@
 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.
index 4d3487b..468c5ca 100644 (file)
@@ -1,7 +1,6 @@
 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
index 92c2465..779f7b6 100644 (file)
@@ -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]