From d0c2f3a2b6ec2d3ee2b9f017eb52c72cf6187d6f Mon Sep 17 00:00:00 2001 From: Artem Pyanykh Date: Wed, 11 Sep 2019 21:12:32 +0100 Subject: [hadrian] Rebuild programs on dynamicGhcPrograms/ghcProfiled change Currently, if you change these ^ flavour parameters, rebuilding is not triggered, since `programContext` doesn't set up a dependency on those values. Exposing these values via an oracle does set the dependency and properly triggers a rebuild of binaries. Several attempts to factor out these actions ended up in cyclic dependency here or there. I'm not absolutely happy with this variant either, but at least it works. ==== Issue repro: In UserSettings.hs: ``` dbgDynamic = defaultFlavour { name = "dbg-dynamic" , dynamicGhcPrograms = pure True, ... } dbgStatic = defaultFlavour { name = "dbg-static" , dynamicGhcPrograms = pure False ... } ``` Then in console: ``` $ hadrian/build.sh -j --flavour=dbg-dynamic ... does the build $ hadrian/build.sh -j --flavour=dbg-static ... does nothing, considers binaries up to date ``` --- hadrian/hadrian.cabal | 2 ++ hadrian/src/Oracles/Flavour.hs | 33 +++++++++++++++++++++++++++++++++ hadrian/src/Oracles/TestSettings.hs | 2 +- hadrian/src/Rules.hs | 4 +++- hadrian/src/Rules/BinaryDist.hs | 1 + hadrian/src/Rules/Program.hs | 1 + hadrian/src/Rules/Test.hs | 1 + hadrian/src/Settings.hs | 19 +------------------ hadrian/src/Settings/Builders/Make.hs | 1 + hadrian/src/Settings/Program.hs | 24 ++++++++++++++++++++++++ 10 files changed, 68 insertions(+), 20 deletions(-) create mode 100644 hadrian/src/Oracles/Flavour.hs create mode 100644 hadrian/src/Settings/Program.hs diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal index 6037a21849..02c64bc9e7 100644 --- a/hadrian/hadrian.cabal +++ b/hadrian/hadrian.cabal @@ -48,6 +48,7 @@ executable hadrian , Hadrian.Target , Hadrian.Utilities , Oracles.Flag + , Oracles.Flavour , Oracles.Setting , Oracles.ModuleFiles , Oracles.TestSettings @@ -102,6 +103,7 @@ executable hadrian , Settings.Flavours.GhcInGhci , Settings.Packages , Settings.Parser + , Settings.Program , Settings.Warnings , Stage , Target diff --git a/hadrian/src/Oracles/Flavour.hs b/hadrian/src/Oracles/Flavour.hs new file mode 100644 index 0000000000..88e9c89757 --- /dev/null +++ b/hadrian/src/Oracles/Flavour.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeFamilies #-} + +module Oracles.Flavour + ( oracles + , askDynGhcPrograms + , askGhcProfiled + ) where + +import Base +import Flavour +import Settings (flavour) + +newtype DynGhcPrograms = + DynGhcPrograms () deriving (Show, Typeable, Eq, Hashable, Binary, NFData) +type instance RuleResult DynGhcPrograms = Bool + +newtype GhcProfiled = + GhcProfiled () deriving (Show, Typeable, Eq, Hashable, Binary, NFData) +type instance RuleResult GhcProfiled = Bool + +oracles :: Rules () +oracles = do + void $ addOracle $ \(DynGhcPrograms _) -> dynamicGhcPrograms =<< flavour + void $ addOracle $ \(GhcProfiled _) -> ghcProfiled <$> flavour + +askDynGhcPrograms :: Action Bool +askDynGhcPrograms = askOracle $ DynGhcPrograms () + +askGhcProfiled :: Action Bool +askGhcProfiled = askOracle $ GhcProfiled () diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs index 9d93e10cf4..ba89e00beb 100644 --- a/hadrian/src/Oracles/TestSettings.hs +++ b/hadrian/src/Oracles/TestSettings.hs @@ -10,8 +10,8 @@ module Oracles.TestSettings import Base import Hadrian.Oracles.TextFile import Oracles.Setting (topDirectory, setting, Setting(..)) -import Settings (programContext) import Packages +import Settings.Program (programContext) testConfigFile :: Action FilePath testConfigFile = buildRoot <&> (-/- "test/ghcconfig") diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs index 5b2682390a..e72623d4ce 100644 --- a/hadrian/src/Rules.hs +++ b/hadrian/src/Rules.hs @@ -8,6 +8,7 @@ import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile import Expression +import qualified Oracles.Flavour import qualified Oracles.ModuleFiles import Packages import qualified Rules.BinaryDist @@ -24,10 +25,10 @@ import qualified Rules.Register import qualified Rules.Rts import qualified Rules.SimpleTargets import Settings +import Settings.Program (programContext) import Target import UserSettings - -- | @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@ @@ -176,4 +177,5 @@ oracleRules = do Hadrian.Oracles.DirectoryContents.directoryContentsOracle Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle + Oracles.Flavour.oracles Oracles.ModuleFiles.moduleFilesOracle diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs index 11301a0372..fb7fa47c84 100644 --- a/hadrian/src/Rules/BinaryDist.hs +++ b/hadrian/src/Rules/BinaryDist.hs @@ -7,6 +7,7 @@ import Expression import Oracles.Setting import Packages import Settings +import Settings.Program (programContext) import Target import Utilities diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs index b5dde25624..6273f3da4d 100644 --- a/hadrian/src/Rules/Program.hs +++ b/hadrian/src/Rules/Program.hs @@ -12,6 +12,7 @@ import Oracles.Setting (topDirectory) import Packages import Settings import Settings.Default +import Settings.Program (programContext) import Target import Utilities import Rules.Library diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs index 5dea40a48b..84374ff492 100644 --- a/hadrian/src/Rules/Test.hs +++ b/hadrian/src/Rules/Test.hs @@ -12,6 +12,7 @@ import Packages import Settings import Settings.Default import Settings.Builders.RunTest +import Settings.Program (programContext) import Target import Utilities diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs index 0548bccfae..ba0cff770a 100755 --- a/hadrian/src/Settings.hs +++ b/hadrian/src/Settings.hs @@ -1,8 +1,7 @@ module Settings ( getArgs, getLibraryWays, getRtsWays, flavour, knownPackages, findPackageByName, unsafeFindPackageByName, unsafeFindPackageByPath, - isLibrary, stagePackages, programContext, getIntegerPackage, - completeSetting + isLibrary, stagePackages, getIntegerPackage, completeSetting ) where import CommandLine @@ -68,22 +67,6 @@ flavour = do getIntegerPackage :: Expr Package getIntegerPackage = expr (integerLibrary =<< flavour) --- TODO: there is duplication and inconsistency between this and --- Rules.Program.getProgramContexts. There should only be one way to get a --- context / contexts for a given stage and package. -programContext :: Stage -> Package -> Action Context -programContext stage pkg = do - profiled <- ghcProfiled <$> flavour - dynGhcProgs <- dynamicGhcPrograms =<< flavour - return $ Context stage pkg (wayFor profiled dynGhcProgs) - - where wayFor prof dyn - | prof && dyn = - error "programContext: profiling+dynamic not supported" - | pkg == ghc && prof && stage > Stage0 = profiling - | dyn && stage > Stage0 = dynamic - | otherwise = vanilla - -- TODO: switch to Set Package as the order of packages should not matter? -- Otherwise we have to keep remembering to sort packages from time to time. knownPackages :: [Package] diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs index 56bb8e35fb..431c2cb22e 100644 --- a/hadrian/src/Settings/Builders/Make.hs +++ b/hadrian/src/Settings/Builders/Make.hs @@ -4,6 +4,7 @@ import Oracles.Setting import Packages import Rules.Gmp import Settings.Builders.Common +import Settings.Program (programContext) import CommandLine makeBuilderArgs :: Args diff --git a/hadrian/src/Settings/Program.hs b/hadrian/src/Settings/Program.hs new file mode 100644 index 0000000000..d98b1a9327 --- /dev/null +++ b/hadrian/src/Settings/Program.hs @@ -0,0 +1,24 @@ +module Settings.Program + ( programContext + ) where + +import Base +import Context +import Oracles.Flavour +import Packages + +-- TODO: there is duplication and inconsistency between this and +-- Rules.Program.getProgramContexts. There should only be one way to +-- get a context/contexts for a given stage and package. +programContext :: Stage -> Package -> Action Context +programContext stage pkg = do + profiled <- askGhcProfiled + dynGhcProgs <- askDynGhcPrograms --dynamicGhcPrograms =<< flavour + return $ Context stage pkg (wayFor profiled dynGhcProgs) + + where wayFor prof dyn + | prof && dyn = + error "programContext: profiling+dynamic not supported" + | pkg == ghc && prof && stage > Stage0 = profiling + | dyn && stage > Stage0 = dynamic + | otherwise = vanilla -- cgit v1.2.1