Unverified Commit 23580909 authored by Andrey Mokhov's avatar Andrey Mokhov Committed by GitHub

Refactor package-specific settings (#622)

* Minor clean up

* Track rts.cabal

* Move all package-specific settings to Settings.Packages, plus another revision, see #540

* Drop Rules.PackageData
parent 0b35e12f
...@@ -22,7 +22,7 @@ executable hadrian ...@@ -22,7 +22,7 @@ executable hadrian
, Builder , Builder
, CommandLine , CommandLine
, Context , Context
, Context.Paths , Context.Path
, Context.Type , Context.Type
, Environment , Environment
, Expression , Expression
...@@ -55,7 +55,6 @@ executable hadrian ...@@ -55,7 +55,6 @@ executable hadrian
, Rules.Clean , Rules.Clean
, Rules.Compile , Rules.Compile
, Rules.Configure , Rules.Configure
, Rules.PackageData
, Rules.Dependencies , Rules.Dependencies
, Rules.Documentation , Rules.Documentation
, Rules.Generate , Rules.Generate
...@@ -94,7 +93,6 @@ executable hadrian ...@@ -94,7 +93,6 @@ executable hadrian
, Settings.Flavours.QuickCross , Settings.Flavours.QuickCross
, Settings.Flavours.Quickest , Settings.Flavours.Quickest
, Settings.Packages , Settings.Packages
, Settings.Packages.Rts
, Settings.Warnings , Settings.Warnings
, Stage , Stage
, Target , Target
......
...@@ -20,12 +20,11 @@ module Base ( ...@@ -20,12 +20,11 @@ module Base (
-- * Files -- * Files
configH, ghcVersionH, configH, ghcVersionH,
-- * Paths -- * Paths
hadrianPath, configPath, configFile, sourcePath, shakeFilesDir, hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
generatedDir, generatedPath, generatedDir, generatedPath, stageBinPath, stageLibPath, templateHscPath,
stageBinPath, stageLibPath, ghcDeps, relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
templateHscPath, ghcDeps,
relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath
) where ) where
import Control.Applicative import Control.Applicative
......
...@@ -13,7 +13,7 @@ module Context ( ...@@ -13,7 +13,7 @@ module Context (
) where ) where
import Base import Base
import Context.Paths import Context.Path
import Context.Type import Context.Type
import Hadrian.Expression import Hadrian.Expression
import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal
...@@ -78,6 +78,7 @@ pkgInplaceConfig context = do ...@@ -78,6 +78,7 @@ pkgInplaceConfig context = do
path <- contextPath context path <- contextPath context
return $ path -/- "inplace-pkg-config" return $ path -/- "inplace-pkg-config"
-- TODO: Add a @Rules FilePath@ alternative.
-- | Path to the @setup-config@ of a given 'Context'. -- | Path to the @setup-config@ of a given 'Context'.
pkgSetupConfigFile :: Context -> Action FilePath pkgSetupConfigFile :: Context -> Action FilePath
pkgSetupConfigFile context = do pkgSetupConfigFile context = do
......
module Context.Paths where module Context.Path where
import Base import Base
import Context.Type import Context.Type
import Hadrian.Expression import Hadrian.Expression
-- | The directory to the current stage -- | The build directory of the current 'Stage'.
stageDir :: Context -> FilePath stageDir :: Context -> FilePath
stageDir Context {..} = stageString stage stageDir Context {..} = stageString stage
-- | The path to the current stage -- | The build path of the current 'Stage'.
stagePath :: Context -> Action FilePath stagePath :: Context -> Action FilePath
stagePath context = buildRoot <&> (-/- stageDir context) stagePath context = buildRoot <&> (-/- stageDir context)
-- | The expression that evaluates to the build path of the current 'Stage'.
getStagePath :: Expr Context b FilePath getStagePath :: Expr Context b FilePath
getStagePath = expr . stagePath =<< getContext getStagePath = expr . stagePath =<< getContext
...@@ -19,10 +20,13 @@ getStagePath = expr . stagePath =<< getContext ...@@ -19,10 +20,13 @@ getStagePath = expr . stagePath =<< getContext
contextDir :: Context -> FilePath contextDir :: Context -> FilePath
contextDir Context {..} = stageString stage -/- pkgPath package contextDir Context {..} = stageString stage -/- pkgPath package
-- | Path to the context directory, containing the "build folder" -- | The path to the directory in 'buildRoot' containing build artifacts of a
-- given 'Context'.
contextPath :: Context -> Action FilePath contextPath :: Context -> Action FilePath
contextPath context = buildRoot <&> (-/- contextDir context) contextPath context = buildRoot <&> (-/- contextDir context)
-- | The expression that evaluates to the path to the directory in 'buildRoot'
-- containing build artifacts of a given 'Context'.
getContextPath :: Expr Context b FilePath getContextPath :: Expr Context b FilePath
getContextPath = expr . contextPath =<< getContext getContextPath = expr . contextPath =<< getContext
...@@ -34,6 +38,6 @@ buildDir context = contextDir context -/- "build" ...@@ -34,6 +38,6 @@ buildDir context = contextDir context -/- "build"
buildPath :: Context -> Action FilePath buildPath :: Context -> Action FilePath
buildPath context = buildRoot <&> (-/- buildDir context) buildPath context = buildRoot <&> (-/- buildDir context)
-- | Get the build path of the current 'Context'. -- | The expression that evaluates to the build path of the current 'Context'.
getBuildPath :: Expr Context b FilePath getBuildPath :: Expr Context b FilePath
getBuildPath = expr . buildPath =<< getContext getBuildPath = expr . buildPath =<< getContext
...@@ -15,7 +15,8 @@ module GHC ( ...@@ -15,7 +15,8 @@ module GHC (
programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
-- * Miscellaneous -- * Miscellaneous
programPath, buildDll0 programPath, buildDll0, rtsContext, rtsBuildPath, libffiContext,
libffiBuildPath, libffiLibraryName
) where ) where
import Base import Base
...@@ -174,3 +175,28 @@ buildDll0 :: Context -> Action Bool ...@@ -174,3 +175,28 @@ buildDll0 :: Context -> Action Bool
buildDll0 Context {..} = do buildDll0 Context {..} = do
windows <- windowsHost windows <- windowsHost
return $ windows && stage == Stage1 && package == compiler return $ windows && stage == Stage1 && package == compiler
-- | RTS is considered a Stage1 package. This determines RTS build directory.
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts
-- | Path to the RTS build directory.
rtsBuildPath :: Action FilePath
rtsBuildPath = buildPath rtsContext
-- | Libffi is considered a Stage1 package. This determines its build directory.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
-- | Build directory for in-tree Libffi library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext
libffiLibraryName :: Action FilePath
libffiLibraryName = do
useSystemFfi <- flag UseSystemFfi
windows <- windowsHost
return $ case (useSystemFfi, windows) of
(True , False) -> "ffi"
(False, False) -> "Cffi"
(_ , True ) -> "Cffi-6"
...@@ -17,7 +17,6 @@ import qualified Rules.Generate ...@@ -17,7 +17,6 @@ import qualified Rules.Generate
import qualified Rules.Gmp import qualified Rules.Gmp
import qualified Rules.Libffi import qualified Rules.Libffi
import qualified Rules.Library import qualified Rules.Library
import qualified Rules.PackageData
import qualified Rules.Program import qualified Rules.Program
import qualified Rules.Register import qualified Rules.Register
import Settings import Settings
...@@ -108,15 +107,15 @@ packageRules = do ...@@ -108,15 +107,15 @@ packageRules = do
Rules.Program.buildProgram readPackageDb Rules.Program.buildProgram readPackageDb
forM_ [Stage0 .. ] $ \stage -> do forM_ [Stage0 .. ] $ \stage ->
-- we create a dummy context, that has the correct state, but contains -- 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 -- @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 -- need to be set properly. @undefined@ is not an option as it ends up
-- being forced. -- being forced.
Rules.Register.registerPackages writePackageDb (Context stage dummyPackage vanilla) Rules.Register.registerPackage writePackageDb (Context stage dummyPackage vanilla)
forM_ vanillaContexts $ mconcat forM_ vanillaContexts $ mconcat
[ Rules.PackageData.buildPackageData [ Rules.Register.configurePackage
, Rules.Dependencies.buildPackageDependencies readPackageDb , Rules.Dependencies.buildPackageDependencies readPackageDb
, Rules.Documentation.buildPackageDocumentation , Rules.Documentation.buildPackageDocumentation
, Rules.Generate.generatePackageCode ] , Rules.Generate.generatePackageCode ]
......
...@@ -10,10 +10,15 @@ import GHC ...@@ -10,10 +10,15 @@ import GHC
import Target import Target
import Utilities import Utilities
-- TODO: Make this list complete.
-- | Files generated by running the @configure@ script.
configureResults :: [FilePath]
configureResults =
[ configFile, "settings", configH, "compiler/ghc.cabal", "rts/rts.cabal"]
configureRules :: Rules () configureRules :: Rules ()
configureRules = do configureRules = do
-- TODO: consider other files we should track here, e.g. @rts/rts.cabal@. configureResults &%> \outs -> do
[configFile, "settings", configH, "compiler/ghc.cabal"] &%> \outs -> do
skip <- not <$> cmdConfigure skip <- not <$> cmdConfigure
if skip if skip
then unlessM (doesFileExist configFile) $ then unlessM (doesFileExist configFile) $
......
...@@ -6,14 +6,13 @@ module Rules.Generate ( ...@@ -6,14 +6,13 @@ module Rules.Generate (
import Base import Base
import Expression import Expression
import Flavour import Flavour
import GHC.Packages import GHC
import Oracles.Flag import Oracles.Flag
import Oracles.ModuleFiles import Oracles.ModuleFiles
import Oracles.Setting import Oracles.Setting
import Rules.Gmp import Rules.Gmp
import Rules.Libffi import Rules.Libffi
import Settings import Settings
import Settings.Packages.Rts
import Target import Target
import Utilities import Utilities
......
...@@ -82,7 +82,7 @@ gmpRules = do ...@@ -82,7 +82,7 @@ gmpRules = do
root <//> "gmp/config.mk" %> \_ -> do root <//> "gmp/config.mk" %> \_ -> do
-- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@ -- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@
-- Building anything in a package transitively depends on its configuration. -- Building anything in a package transitively depends on its configuration.
setupConfig <- contextPath gmpContext <&> (-/- "setup-config") setupConfig <- pkgSetupConfigFile gmpContext
need [setupConfig] need [setupConfig]
-- TODO: Get rid of hard-coded @gmp@. -- TODO: Get rid of hard-coded @gmp@.
......
module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where module Rules.Libffi (libffiRules, libffiDependencies) where
import GHC.Packages import GHC
import Hadrian.Utilities import Hadrian.Utilities
import Settings.Builders.Common import Settings.Builders.Common
import Settings.Packages.Rts
import Target import Target
import Utilities import Utilities
-- | Libffi is considered a Stage1 package. This determines its build directory.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
-- | Build directory for in-tree Libffi library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext
libffiDependencies :: [FilePath] libffiDependencies :: [FilePath]
libffiDependencies = ["ffi.h", "ffitarget.h"] libffiDependencies = ["ffi.h", "ffitarget.h"]
libffiLibrary :: FilePath libffiLibrary :: FilePath
libffiLibrary = "inst/lib/libffi.a" libffiLibrary = "inst/lib/libffi.a"
rtsLibffiLibrary :: Way -> Action FilePath
rtsLibffiLibrary way = do
name <- libffiLibraryName
suf <- libsuf way
rtsPath <- rtsBuildPath
return $ rtsPath -/- "lib" ++ name ++ suf
fixLibffiMakefile :: FilePath -> String -> String fixLibffiMakefile :: FilePath -> String -> String
fixLibffiMakefile top = fixLibffiMakefile top =
replace "-MD" "-MMD" replace "-MD" "-MMD"
. replace "@toolexeclibdir@" "$(libdir)" . replace "@toolexeclibdir@" "$(libdir)"
. replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)") . replace "@INSTALL@" ("$(subst ../install-sh," ++ top ++ "/install-sh,@INSTALL@)")
-- TODO: remove code duplication (see Settings/Builders/GhcCabal.hs)
-- TODO: check code duplication w.r.t. ConfCcArgs -- TODO: check code duplication w.r.t. ConfCcArgs
configureEnvironment :: Action [CmdOption] configureEnvironment :: Action [CmdOption]
configureEnvironment = do configureEnvironment = do
......
module Rules.PackageData (buildPackageData) where
import Base
import Context
import Expression
import GHC.Packages
import Settings.Packages.Rts
import Target
import Utilities
import Hadrian.Haskell.Cabal.Parse (configurePackage)
-- | Build @setup-config@ and @inplace-pkg-config@ files
-- for packages. Look at the "Rules" module to see this
-- instantiated against all the packages.
buildPackageData :: Context -> Rules ()
buildPackageData context@Context {..} = do
root <- buildRootRules
let dir = root -/- contextDir context
dir -/- "setup-config" %> \_ -> configurePackage context
dir -/- "inplace-pkg-config" %> \conf -> do
when (package == rts) $ do
genPath <- buildRoot <&> (-/- generatedDir)
rtsPath <- rtsBuildPath
need [rtsConfIn]
build $ target context HsCpp [rtsConfIn] [conf]
fixFile conf $ unlines
. map
( replace "\"\"" ""
. replace "rts/dist/build" rtsPath
. replace "includes/dist-derivedconstants/header" genPath )
. lines
...@@ -10,7 +10,6 @@ import GHC ...@@ -10,7 +10,6 @@ import GHC
import Oracles.Flag import Oracles.Flag
import Oracles.ModuleFiles import Oracles.ModuleFiles
import Settings import Settings
import Settings.Packages.Rts
import Target import Target
import Utilities import Utilities
......
module Rules.Register (registerPackages) where module Rules.Register (configurePackage, registerPackage) where
import Distribution.ParseUtils
import Distribution.Version (Version)
import Base import Base
import Context import Context
...@@ -7,29 +10,36 @@ import Settings ...@@ -7,29 +10,36 @@ import Settings
import Target import Target
import Utilities import Utilities
import Distribution.ParseUtils
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Version (Version)
import qualified System.Directory as IO
import Hadrian.Expression import Hadrian.Expression
import Hadrian.Haskell.Cabal.Parse as Cabal
import qualified Distribution.Compat.ReadP as Parse
import qualified System.Directory as IO
import qualified Hadrian.Haskell.Cabal.Parse as Cabal
parseCabalName :: String -> Maybe (String, Version) parseCabalName :: String -> Maybe (String, Version)
parseCabalName = readPToMaybe parse parseCabalName = readPToMaybe parse
where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion where
parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion
-- | Build rules for registering packages and initialising package databases -- | Configure a package and build its @setup-config@ file.
-- by running the @ghc-pkg@ utility. configurePackage :: Context -> Rules ()
registerPackages :: [(Resource, Int)] -> Context -> Rules () configurePackage context@Context {..} = do
registerPackages rs context@Context {..} = do
root <- buildRootRules root <- buildRootRules
root -/- relativePackageDbPath stage %> buildStamp rs context root -/- contextDir context -/- "setup-config" %> \_ ->
Cabal.configurePackage context
-- | Registering a package and initialise the corresponding package database if
-- need be.
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
registerPackage rs context@Context {..} = do
root <- buildRootRules
-- Initialise the package database.
root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp -> root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp ->
writeFileLines stamp [] writeFileLines stamp []
-- TODO: Add proper error handling for partial functions. -- TODO: Add proper error handling for partial functions.
-- Register a package.
root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do
settings <- libPath context <&> (-/- "settings") settings <- libPath context <&> (-/- "settings")
platformConstants <- libPath context <&> (-/- "platformConstants") platformConstants <- libPath context <&> (-/- "platformConstants")
...@@ -46,9 +56,8 @@ buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () ...@@ -46,9 +56,8 @@ buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildConf _ context@Context {..} _conf = do buildConf _ context@Context {..} _conf = do
depPkgIds <- cabalDependencies context depPkgIds <- cabalDependencies context
-- Calling 'need' on @setup-config@, triggers @ghc-cabal configure@ -- Calling 'need' on @setupConfig@, triggers the package configuration.
-- Building anything in a package transitively depends on its configuration. setupConfig <- pkgSetupConfigFile context
setupConfig <- contextPath context <&> (-/- "setup-config")
need [setupConfig] need [setupConfig]
need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
...@@ -71,8 +80,8 @@ buildConf _ context@Context {..} _conf = do ...@@ -71,8 +80,8 @@ buildConf _ context@Context {..} _conf = do
when (package == integerGmp) $ need [path -/- "ghc-gmp.h"] when (package == integerGmp) $ need [path -/- "ghc-gmp.h"]
-- Copy and register the package. -- Copy and register the package.
copyPackage context Cabal.copyPackage context
registerPackage context Cabal.registerPackage context
copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action () copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action ()
copyConf rs context@Context {..} conf = do copyConf rs context@Context {..} conf = do
...@@ -94,9 +103,3 @@ copyConf rs context@Context {..} conf = do ...@@ -94,9 +103,3 @@ copyConf rs context@Context {..} conf = do
where where
stdOutToPkgIds :: String -> [String] stdOutToPkgIds :: String -> [String]
stdOutToPkgIds = drop 1 . concatMap words . lines stdOutToPkgIds = drop 1 . concatMap words . lines
buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildStamp rs Context {..} path = do
buildWithResources rs $
target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path]
putSuccess $ "| Successfully initialised " ++ path
module Settings.Builders.Configure (configureBuilderArgs) where module Settings.Builders.Configure (configureBuilderArgs) where
import GHC
import Rules.Gmp import Rules.Gmp
import Rules.Libffi
import Settings.Builders.Common import Settings.Builders.Common
configureBuilderArgs :: Args configureBuilderArgs :: Args
......
...@@ -3,7 +3,6 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where ...@@ -3,7 +3,6 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where
import GHC import GHC
import Oracles.Setting import Oracles.Setting
import Rules.Gmp import Rules.Gmp
import Rules.Libffi
import Settings.Builders.Common import Settings.Builders.Common
makeBuilderArgs :: Args makeBuilderArgs :: Args
......
...@@ -26,7 +26,6 @@ import Settings.Builders.Make ...@@ -26,7 +26,6 @@ import Settings.Builders.Make
import Settings.Builders.RunTest import Settings.Builders.RunTest
import Settings.Builders.Xelatex import Settings.Builders.Xelatex
import Settings.Packages import Settings.Packages
import Settings.Packages.Rts
import Settings.Warnings import Settings.Warnings
import {-# SOURCE #-} Builder import {-# SOURCE #-} Builder
...@@ -152,7 +151,4 @@ defaultBuilderArgs = mconcat ...@@ -152,7 +151,4 @@ defaultBuilderArgs = mconcat
-- | All 'Package'-dependent command line arguments. -- | All 'Package'-dependent command line arguments.
defaultPackageArgs :: Args defaultPackageArgs :: Args
defaultPackageArgs = mconcat defaultPackageArgs = mconcat [ packageArgs, warningArgs ]
[ packageArgs
, rtsPackageArgs
, warningArgs ]
...@@ -2,19 +2,19 @@ module Settings.Packages (packageArgs) where ...@@ -2,19 +2,19 @@ module Settings.Packages (packageArgs) where
import Expression import Expression
import Flavour import Flavour
import GHC.Packages import GHC
import Oracles.Setting import Oracles.Setting
import Oracles.Flag import Oracles.Flag
import Rules.Gmp import Rules.Gmp
import Settings import Settings
-- TODO: Finish migration of package-specific settings into a single file. -- | Package-specific command-line arguments.
packageArgs :: Args packageArgs :: Args
packageArgs = do packageArgs = do
intLib <- getIntegerPackage intLib <- getIntegerPackage
stage <- getStage stage <- getStage
rtsWays <- getRtsWays
path <- getBuildPath path <- getBuildPath
rtsWays <- getRtsWays
compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler) compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler)
gmpBuildPath <- expr gmpBuildPath gmpBuildPath <- expr gmpBuildPath
...@@ -139,6 +139,14 @@ packageArgs = do ...@@ -139,6 +139,14 @@ packageArgs = do
arg ("--configure-option=CFLAGS=" ++ includeGmp) arg ("--configure-option=CFLAGS=" ++ includeGmp)
, arg ("--gcc-options=" ++ includeGmp) ] ] , arg ("--gcc-options=" ++ includeGmp) ] ]
---------------------------------- rts ---------------------------------
, package rts ? rtsPackageArgs -- RTS deserves a separate function
-------------------------------- runGhc --------------------------------
, package runGhc ?
builder Ghc ? input "//Main.hs" ?
(\version -> ["-cpp", "-DVERSION=" ++ show version]) <$> getSetting ProjectVersion
--------------------------------- text --------------------------------- --------------------------------- text ---------------------------------
-- The package @text@ is rather tricky. It's a boot library, and it -- The package @text@ is rather tricky. It's a boot library, and it
-- tries to determine on its own if it should link against @integer-gmp@ -- tries to determine on its own if it should link against @integer-gmp@
...@@ -150,13 +158,205 @@ packageArgs = do ...@@ -150,13 +158,205 @@ packageArgs = do
-- in Stage1, and at that point the configuration is just wrong. -- in Stage1, and at that point the configuration is just wrong.
, package text ? , package text ?
builder CabalFlags ? notStage0 ? intLib == integerSimple ? builder CabalFlags ? notStage0 ? intLib == integerSimple ?
pure [ "+integer-simple", "-bytestring-builder"] pure [ "+integer-simple", "-bytestring-builder"] ]