From df9ffa8e8e58e0e3e9a7ac4764f980e80e4e6dea Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Fri, 23 Feb 2018 09:22:21 +0100 Subject: [PATCH 01/28] Use Cabal directly in place of ghc-cabal; make build root configurable. This commit implements two significant changes (that were not easy to separate): - Don't use ghc-cabal anymore for getting information about Haskell packages. We now instead directly use Cabal-the-library. - Make the build root configurable. This effectively gets rid of the inplace logic and allows us to place _all_ build artefacts in some directory of our choice, by passing '--build-root ' to hadrian. The code for this was mostly taken from #445. --- cfg/system.config.in | 2 + hadrian.cabal | 17 +- src/Base.hs | 78 +++--- src/Builder.hs | 70 ++++-- src/Builder.hs-boot | 49 ++++ src/CommandLine.hs | 22 +- src/Context.hs | 56 ++--- src/Context/Paths.hs | 39 +++ src/Expression.hs | 26 +- src/Expression/Type.hs | 5 +- src/GHC.hs | 201 ++++----------- src/GHC/Packages.hs | 106 ++++++++ src/Hadrian/Builder.hs | 47 +++- src/Hadrian/Haskell/Cabal.hs | 28 ++- src/Hadrian/Haskell/Cabal/Configured.hs | 55 +++++ src/Hadrian/Haskell/Cabal/Parse.hs | 297 +++++++++++++++++++++-- src/Hadrian/Haskell/Cabal/Parse.hs-boot | 9 + src/Hadrian/Haskell/Cabal/Type.hs | 21 +- src/Hadrian/Oracles/TextFile.hs | 46 +++- src/Hadrian/Package.hs | 1 + src/Hadrian/Utilities.hs | 16 +- src/Main.hs | 7 +- src/Oracles/ModuleFiles.hs | 40 ++- src/Oracles/PackageData.hs | 66 ----- src/Oracles/Setting.hs | 4 +- src/Rules.hs | 111 +++++++-- src/Rules/Clean.hs | 10 +- src/Rules/Compile.hs | 6 +- src/Rules/Dependencies.hs | 13 +- src/Rules/Documentation.hs | 70 ++++-- src/Rules/Generate.hs | 133 +++++----- src/Rules/Gmp.hs | 30 +-- src/Rules/Install.hs | 5 +- src/Rules/Libffi.hs | 13 +- src/Rules/Library.hs | 72 ++++-- src/Rules/PackageData.hs | 119 ++------- src/Rules/Program.hs | 116 +++------ src/Rules/Register.hs | 103 ++++++-- src/Rules/SourceDist.hs | 2 +- src/Rules/Test.hs | 3 +- src/Rules/Wrappers.hs | 7 +- src/Settings.hs | 6 +- src/Settings/Builders/Cc.hs | 6 +- src/Settings/Builders/Common.hs | 38 ++- src/Settings/Builders/DeriveConstants.hs | 1 + src/Settings/Builders/Ghc.hs | 55 +++-- src/Settings/Builders/GhcCabal.hs | 79 +++++- src/Settings/Builders/GhcPkg.hs | 16 +- src/Settings/Builders/Haddock.hs | 20 +- src/Settings/Builders/HsCpp.hs | 3 +- src/Settings/Builders/Hsc2Hs.hs | 25 +- src/Settings/Builders/RunTest.hs | 5 +- src/Settings/Default.hs | 51 ++-- src/Settings/Packages.hs | 125 ++++++++++ src/Settings/Packages/Haskeline.hs | 8 - src/Settings/Packages/Rts.hs | 1 + src/Settings/Warnings.hs | 1 + src/UserSettings.hs | 4 +- src/Utilities.hs | 46 ++-- 59 files changed, 1678 insertions(+), 933 deletions(-) create mode 100644 src/Builder.hs-boot create mode 100644 src/Context/Paths.hs create mode 100644 src/GHC/Packages.hs create mode 100644 src/Hadrian/Haskell/Cabal/Configured.hs create mode 100644 src/Hadrian/Haskell/Cabal/Parse.hs-boot delete mode 100644 src/Oracles/PackageData.hs mode change 100644 => 100755 src/Settings.hs create mode 100644 src/Settings/Packages.hs delete mode 100644 src/Settings/Packages/Haskeline.hs diff --git a/cfg/system.config.in b/cfg/system.config.in index c983ae4a50..93002a2448 100644 --- a/cfg/system.config.in +++ b/cfg/system.config.in @@ -106,6 +106,8 @@ conf-ld-linker-args-stage0 = @CONF_LD_LINKER_OPTS_STAGE0@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ +conf-hs-cpp-args = @HaskellCPPArgs@ + # Include and library directories: #================================= diff --git a/hadrian.cabal b/hadrian.cabal index 6248df3d75..c9f3fae651 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -22,18 +22,21 @@ executable hadrian , Builder , CommandLine , Context + , Context.Paths , Context.Type , Environment , Expression , Expression.Type , Flavour , GHC + , GHC.Packages , Hadrian.Builder , Hadrian.Builder.Ar , Hadrian.Builder.Sphinx , Hadrian.Builder.Tar , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Cabal.Configured , Hadrian.Haskell.Cabal.Parse , Hadrian.Haskell.Cabal.Type , Hadrian.Oracles.ArgsHash @@ -47,7 +50,6 @@ executable hadrian , Oracles.Flag , Oracles.Setting , Oracles.ModuleFiles - , Oracles.PackageData , Rules , Rules.Clean , Rules.Compile @@ -91,19 +93,8 @@ executable hadrian , Settings.Flavours.Quick , Settings.Flavours.QuickCross , Settings.Flavours.Quickest - , Settings.Packages.Base - , Settings.Packages.Cabal - , Settings.Packages.Compiler - , Settings.Packages.Ghc - , Settings.Packages.GhcCabal - , Settings.Packages.Ghci - , Settings.Packages.GhcPkg - , Settings.Packages.GhcPrim - , Settings.Packages.Haddock - , Settings.Packages.Haskeline - , Settings.Packages.IntegerGmp + , Settings.Packages , Settings.Packages.Rts - , Settings.Packages.RunGhc , Settings.Warnings , Stage , Target diff --git a/src/Base.hs b/src/Base.hs index c3cb353a56..0f9eaf00e7 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -18,12 +18,14 @@ module Base ( module Stage, module Way, + -- * Files + configH, ghcVersionH, -- * Paths - hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir, - generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, - inplaceLibCopyTargets, haddockHtmlResourcesStamp, templateHscPath, - stage0PackageDbDir, inplacePackageDbPath, packageDbPath, packageDbStamp, - ghcSplitPath + hadrianPath, configPath, configFile, sourcePath, shakeFilesDir, + generatedDir, generatedPath, + stageBinPath, stageLibPath, +templateHscPath, ghcDeps, + relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath ) where import Control.Applicative @@ -65,71 +67,55 @@ sourcePath = hadrianPath -/- "src" configH :: FilePath configH = "mk/config.h" +ghcVersionH :: Action FilePath +ghcVersionH = generatedPath <&> (-/- "ghcversion.h") + -- | The directory in 'buildRoot' containing the Shake database and other -- auxiliary files generated by Hadrian. shakeFilesDir :: FilePath shakeFilesDir = "hadrian" --- | Directory for binaries that are built "in place". -inplaceBinPath :: FilePath -inplaceBinPath = "inplace/bin" - --- | Directory for libraries that are built "in place". -inplaceLibPath :: FilePath -inplaceLibPath = "inplace/lib" - --- | Directory for binary wrappers, and auxiliary binaries such as @touchy@. -inplaceLibBinPath :: FilePath -inplaceLibBinPath = inplaceLibPath -/- "bin" - -- | The directory in 'buildRoot' containing generated source files that are not -- package-specific, e.g. @ghcplatform.h@. generatedDir :: FilePath generatedDir = "generated" --- | The directory in 'buildRoot' containing the 'Stage0' package database. -stage0PackageDbDir :: FilePath -stage0PackageDbDir = "stage0/bootstrapping.conf" +generatedPath :: Action FilePath +generatedPath = buildRoot <&> (-/- generatedDir) -- | Path to the inplace package database used in 'Stage1' and later. -inplacePackageDbPath :: FilePath -inplacePackageDbPath = inplaceLibPath -/- "package.conf.d" +relativePackageDbPath :: Stage -> FilePath +relativePackageDbPath stage = stageString stage -/- "lib" -/- "package.conf.d" -- | Path to the package database used in a given 'Stage'. packageDbPath :: Stage -> Action FilePath -packageDbPath Stage0 = buildRoot <&> (-/- stage0PackageDbDir) -packageDbPath _ = return inplacePackageDbPath +packageDbPath stage = buildRoot <&> (-/- relativePackageDbPath stage) -- | We use a stamp file to track the existence of a package database. packageDbStamp :: FilePath packageDbStamp = ".stamp" --- ref: GHC_DEPENDENCIES in ghc/ghc.mk --- ref: INSTALL_LIBS in driver/ghc.mk --- TODO: Derive this from Builder.runtimeDependencies --- | Files that need to be copied over to 'inplaceLibPath'. -inplaceLibCopyTargets :: [FilePath] -inplaceLibCopyTargets = map (inplaceLibPath -/-) - [ "ghc-usage.txt" - , "ghci-usage.txt" - , "llvm-targets" - , "platformConstants" - , "settings" - , "template-hsc.h" ] - --- TODO: This is fragile and will break if @README.md@ is removed. We need to --- improve the story of program runtime dependencies on directories. --- See: https://github.com/snowleopard/hadrian/issues/492. --- | Path to a file in Haddock's HTML resource library. -haddockHtmlResourcesStamp :: FilePath -haddockHtmlResourcesStamp = inplaceLibPath -/- "html/README.md" +stageBinPath :: Stage -> Action FilePath +stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin") + +stageLibPath :: Stage -> Action FilePath +stageLibPath stage = buildRoot <&> (-/- stageString stage -/- "lib") + +-- | Files the `ghc` binary depends on +ghcDeps :: Stage -> Action [FilePath] +ghcDeps stage = mapM (\f -> stageLibPath stage <&> (-/- f)) + [ "ghc-usage.txt" + , "ghci-usage.txt" + , "llvm-targets" + , "platformConstants" + , "settings" ] -- ref: utils/hsc2hs/ghc.mk -- | Path to 'hsc2hs' template. -templateHscPath :: FilePath -templateHscPath = inplaceLibPath -/- "template-hsc.h" +templateHscPath :: Stage -> Action FilePath +templateHscPath stage = stageLibPath stage <&> (-/- "template-hsc.h") -- | @ghc-split@ is a Perl script used by GHC when run with @-split-objs@ flag. -- It is generated in "Rules.Generate". ghcSplitPath :: FilePath -ghcSplitPath = inplaceLibBinPath -/- "ghc-split" +ghcSplitPath = "path/to/ghc-split" -- TODO: fix this diff --git a/src/Builder.hs b/src/Builder.hs index 67e1634453..ed160ba61f 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -1,9 +1,11 @@ {-# LANGUAGE InstanceSigs #-} module Builder ( -- * Data types - ArMode (..), CcMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..), + ArMode (..), CcMode (..), GhcCabalMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..), SphinxMode (..), TarMode (..), Builder (..), + builderPath', + -- * Builder properties builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, @@ -53,8 +55,20 @@ instance Binary GhcMode instance Hashable GhcMode instance NFData GhcMode +-- | GHC cabal mode. Can configure, copy and register pacakges. +data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist + deriving (Eq, Generic, Show) + +instance Binary GhcCabalMode +instance Hashable GhcCabalMode +instance NFData GhcCabalMode + -- | GhcPkg can initialise a package database and register packages in it. -data GhcPkgMode = Init | Update deriving (Eq, Generic, Show) +data GhcPkgMode = Init -- initialize a new database. + | Update -- update a package. + | Clone -- clone a package from one pkg database into another. @Copy@ is already taken by GhcCabalMode. + | Dependencies -- compute package dependencies. + deriving (Eq, Generic, Show) instance Binary GhcPkgMode instance Hashable GhcPkgMode @@ -82,15 +96,15 @@ data Builder = Alex | GenApply | GenPrimopCode | Ghc GhcMode Stage - | GhcCabal + | GhcCabal GhcCabalMode Stage | GhcPkg GhcPkgMode Stage | Haddock HaddockMode | Happy | Hpc | Hp2Ps | HsCpp - | Hsc2Hs - | Ld + | Hsc2Hs Stage + | Ld Stage | Make FilePath | Nm | Objdump @@ -103,6 +117,9 @@ data Builder = Alex | Tar TarMode | Unlit | Xelatex + | CabalFlags Stage -- ^ a virtual builder to use the Arg predicate logic + -- to collect cabal flags. +x, -x + deriving (Eq, Generic, Show) instance Binary Builder @@ -119,18 +136,21 @@ builderProvenance = \case GenPrimopCode -> context Stage0 genprimopcode Ghc _ Stage0 -> Nothing Ghc _ stage -> context (pred stage) ghc - GhcCabal -> context Stage0 ghcCabal + GhcCabal _ _ -> context Stage1 ghcCabal GhcPkg _ Stage0 -> Nothing GhcPkg _ _ -> context Stage0 ghcPkg Haddock _ -> context Stage2 haddock Hpc -> context Stage1 hpcBin Hp2Ps -> context Stage0 hp2ps - Hsc2Hs -> context Stage0 hsc2hs + Hsc2Hs _ -> context Stage0 hsc2hs Unlit -> context Stage0 unlit _ -> Nothing where context s p = Just $ vanillaContext s p +builderPath' :: Builder -> Action FilePath +builderPath' = builderPath + instance H.Builder Builder where builderPath :: Builder -> Action FilePath builderPath builder = case builderProvenance builder of @@ -142,24 +162,37 @@ instance H.Builder Builder where Configure dir -> return [dir -/- "configure"] Ghc _ Stage0 -> return [] - Ghc _ _ -> do + Ghc _ stage -> do win <- windowsHost touchyPath <- programPath (vanillaContext Stage0 touchy) unlitPath <- builderPath Unlit + ghcdeps <- ghcDeps stage return $ [ ghcSplitPath -- TODO: Make conditional on --split-objects - , inplaceLibPath -/- "ghc-usage.txt" - , inplaceLibPath -/- "ghci-usage.txt" - , inplaceLibPath -/- "llvm-targets" - , inplaceLibPath -/- "platformConstants" - , inplaceLibPath -/- "settings" , unlitPath ] + ++ ghcdeps ++ [ touchyPath | win ] - Haddock _ -> return [haddockHtmlResourcesStamp] - Hsc2Hs -> return [templateHscPath] + Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage Make dir -> return [dir -/- "Makefile"] _ -> return [] + -- query the builder for some information. + -- contrast this with runBuilderWith, which returns @Action ()@ + -- this returns the @stdout@ from running the builder. + -- For now this only implements asking @ghc-pkg@ about pacakge + -- dependencies. + askBuilderWith :: Builder -> BuildInfo -> Action String + askBuilderWith builder BuildInfo {..} = case builder of + GhcPkg Dependencies _ -> do + let input = fromSingleton msgIn buildInputs + msgIn = "[askBuilder] Exactly one input file expected." + needBuilder builder + path <- H.builderPath builder + need [path] + Stdout stdout <- cmd [path] ["--no-user-package-db", "field", input, "depends"] + return stdout + _ -> error $ "Builder " ++ show builder ++ " can not be asked!" + runBuilderWith :: Builder -> BuildInfo -> Action () runBuilderWith builder BuildInfo {..} = do path <- builderPath builder @@ -208,6 +241,11 @@ instance H.Builder Builder where unit $ cmd [Cwd output] [path] buildArgs unit $ cmd [Cwd output] [path] buildArgs + GhcPkg Clone _ -> do + -- input is "virtual" here. it's essentially a package name + Stdout pkgDesc <- cmd [path] ["--expand-pkgroot", "--no-user-package-db", "describe", input ] + cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"]) + _ -> cmd echo [path] buildArgs -- TODO: Some builders are required only on certain platforms. For example, @@ -233,7 +271,7 @@ systemBuilderPath builder = case builder of GhcPkg _ Stage0 -> fromKey "system-ghc-pkg" Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" - Ld -> fromKey "ld" + Ld _ -> fromKey "ld" Make _ -> fromKey "make" Nm -> fromKey "nm" Objdump -> fromKey "objdump" diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot new file mode 100644 index 0000000000..05136dab6b --- /dev/null +++ b/src/Builder.hs-boot @@ -0,0 +1,49 @@ +module Builder where + +import Stage +import Hadrian.Builder.Ar +import Hadrian.Builder.Sphinx +import Hadrian.Builder.Tar +import Development.Shake + +data CcMode = CompileC | FindCDependencies +data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs +data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist +data GhcPkgMode = Init | Update | Clone | Dependencies +data HaddockMode = BuildPackage | BuildIndex + +data Builder = Alex + | Ar ArMode Stage + | DeriveConstants + | Cc CcMode Stage + | Configure FilePath + | GenApply + | GenPrimopCode + | Ghc GhcMode Stage + | GhcCabal GhcCabalMode Stage + | GhcPkg GhcPkgMode Stage + | Haddock HaddockMode + | Happy + | Hpc + | Hp2Ps + | HsCpp + | Hsc2Hs Stage + | Ld Stage + | Make FilePath + | Nm + | Objdump + | Patch + | Perl + | Python + | Ranlib + | RunTest + | Sphinx SphinxMode + | Tar TarMode + | Unlit + | Xelatex + | CabalFlags Stage + +instance Eq Builder +instance Show Builder + +builderPath' :: Builder -> Action FilePath diff --git a/src/CommandLine.hs b/src/CommandLine.hs index e747a52a53..6a63fef15f 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -1,16 +1,17 @@ module CommandLine ( optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, cmdIntegerSimple, cmdProgressColour, cmdProgressInfo, cmdConfigure, cmdSplitObjects, - cmdInstallDestDir, TestArgs(..), defaultTestArgs + cmdInstallDestDir, lookupBuildRoot, TestArgs(..), defaultTestArgs ) where import Data.Either import qualified Data.HashMap.Strict as Map import Data.List.Extra import Development.Shake hiding (Normal) -import Hadrian.Utilities +import Hadrian.Utilities hiding (buildRoot) import System.Console.GetOpt import System.Environment +import qualified UserSettings -- | All arguments that can be passed to Hadrian via the command line. data CommandLineArgs = CommandLineArgs @@ -22,6 +23,7 @@ data CommandLineArgs = CommandLineArgs , progressColour :: UseColour , progressInfo :: ProgressInfo , splitObjects :: Bool + , buildRoot :: BuildRoot , testArgs :: TestArgs } deriving (Eq, Show) @@ -36,6 +38,7 @@ defaultCommandLineArgs = CommandLineArgs , progressColour = Auto , progressInfo = Brief , splitObjects = False + , buildRoot = UserSettings.userBuildRoot , testArgs = defaultTestArgs } -- | These arguments are used by the `test` target. @@ -62,6 +65,15 @@ readConfigure = Right $ \flags -> flags { configure = True } readFlavour :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs) readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms } +readBuildRoot :: Maybe FilePath -> Either String (CommandLineArgs -> CommandLineArgs) +readBuildRoot ms = + maybe (Left "Cannot parse build-root") (Right . set) (go =<< ms) + where + go :: String -> Maybe BuildRoot + go = Just . BuildRoot + set :: BuildRoot -> CommandLineArgs -> CommandLineArgs + set flag flags = flags { buildRoot = flag } + readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs) readFreeze1 = Right $ \flags -> flags { freeze1 = True } @@ -124,6 +136,8 @@ optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))] optDescrs = [ Option ['c'] ["configure"] (NoArg readConfigure) "Run the boot and configure scripts (if you do not want to run them manually)." + , Option ['o'] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT") + "Where to store build artefacts. (Default _build)." , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR") "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)." , Option [] ["freeze1"] (NoArg readFreeze1) @@ -157,6 +171,7 @@ cmdLineArgsMap = do let args = foldl (flip id) defaultCommandLineArgs (rights opts) return $ insertExtra (progressColour args) -- Accessed by Hadrian.Utilities $ insertExtra (progressInfo args) -- Accessed by Hadrian.Utilities + $ insertExtra (buildRoot args) -- Accessed by Hadrian.Utilities $ insertExtra (testArgs args) -- Accessed by Settings.Builders.RunTest $ insertExtra args Map.empty @@ -169,6 +184,9 @@ cmdConfigure = configure <$> cmdLineArgs cmdFlavour :: Action (Maybe String) cmdFlavour = flavour <$> cmdLineArgs +lookupBuildRoot :: Map.HashMap TypeRep Dynamic -> BuildRoot +lookupBuildRoot = buildRoot . lookupExtra defaultCommandLineArgs + lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs diff --git a/src/Context.hs b/src/Context.hs index 6377d9bb93..b1cf2c6002 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -7,16 +7,18 @@ module Context ( withHsPackage, -- * Paths - contextDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile, + contextDir, buildPath, buildDir, + pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile, pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile, - pkgConfFile, objectPath + pkgConfFile, objectPath, contextPath, getContextPath, + libDir, libPath ) where +import Base +import Context.Paths import Context.Type import Hadrian.Expression import Hadrian.Haskell.Cabal - -import Base import Oracles.Setting -- | Most targets are built only one way, hence the notion of 'vanillaContext'. @@ -46,52 +48,48 @@ getStagedSettingList f = getSettingList . f =<< getStage -- | Construct an expression that depends on the Cabal file of the current -- package and is empty in a non-Haskell context. -withHsPackage :: (Monoid a, Semigroup a) => (FilePath -> Expr Context b a) -> Expr Context b a +withHsPackage :: (Monoid a, Semigroup a) => (Context -> Expr Context b a) -> Expr Context b a withHsPackage expr = do pkg <- getPackage + ctx <- getContext case pkgCabalFile pkg of - Just file -> expr file - Nothing -> mempty - --- | The directory in 'buildRoot' containing build artefacts of a given 'Context'. -contextDir :: Context -> FilePath -contextDir Context {..} = stageString stage -/- pkgPath package + Just _ -> expr ctx + Nothing -> mempty --- | Path to the directory containing build artefacts of a given 'Context'. -buildPath :: Context -> Action FilePath -buildPath context = buildRoot <&> (-/- contextDir context) +pkgId :: Context -> Action FilePath +pkgId ctx@Context {..} = case pkgCabalFile package of + Just _ -> pkgIdentifier ctx + Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts --- | Get the build path of the current 'Context'. -getBuildPath :: Expr Context b FilePath -getBuildPath = expr . buildPath =<< getContext +libDir :: Context -> FilePath +libDir Context {..} = stageString stage -/- "lib" -pkgId :: Package -> Action FilePath -pkgId package = case pkgCabalFile package of - Just file -> pkgIdentifier file - Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts +-- | Path to the directory containg the final artifact in a given 'Context' +libPath :: Context -> Action FilePath +libPath context = buildRoot <&> (-/- libDir context) pkgFile :: Context -> String -> String -> Action FilePath pkgFile context@Context {..} prefix suffix = do path <- buildPath context - pid <- pkgId package + pid <- pkgId context return $ path -/- prefix ++ pid ++ suffix -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath pkgInplaceConfig context = do - path <- buildPath context + path <- contextPath context return $ path -/- "inplace-pkg-config" -- | Path to the @package-data.mk@ of a given 'Context'. pkgDataFile :: Context -> Action FilePath pkgDataFile context = do - path <- buildPath context + path <- contextPath context return $ path -/- "package-data.mk" -- | Path to the @setup-config@ of a given 'Context'. pkgSetupConfigFile :: Context -> Action FilePath pkgSetupConfigFile context = do - path <- buildPath context + path <- contextPath context return $ path -/- "setup-config" -- | Path to the haddock file of a given 'Context', e.g.: @@ -123,12 +121,10 @@ pkgGhciLibraryFile context = pkgFile context "HS" ".o" -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do +pkgConfFile ctx@Context {..} = do root <- buildRoot - pid <- pkgId package - let dbDir | stage == Stage0 = root -/- stage0PackageDbDir - | otherwise = inplacePackageDbPath - return $ dbDir -/- pid <.> "conf" + pid <- pkgId ctx + return $ root -/- relativePackageDbPath stage -/- pid <.> "conf" -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath' -- to its object file. For example: diff --git a/src/Context/Paths.hs b/src/Context/Paths.hs new file mode 100644 index 0000000000..32ccf45cd4 --- /dev/null +++ b/src/Context/Paths.hs @@ -0,0 +1,39 @@ +module Context.Paths where + +import Base +import Context.Type +import Hadrian.Expression + +-- | The directory to the current stage +stageDir :: Context -> FilePath +stageDir Context {..} = stageString stage + +-- | The path to the current stage +stagePath :: Context -> Action FilePath +stagePath context = buildRoot <&> (-/- stageDir context) + +getStagePath :: Expr Context b FilePath +getStagePath = expr . stagePath =<< getContext + +-- | The directory in 'buildRoot' containing build artifacts of a given 'Context'. +contextDir :: Context -> FilePath +contextDir Context {..} = stageString stage -/- pkgPath package + +-- | Path to the context directory, containing the "build folder" +contextPath :: Context -> Action FilePath +contextPath context = buildRoot <&> (-/- contextDir context) + +getContextPath :: Expr Context b FilePath +getContextPath = expr . contextPath =<< getContext + +-- | The directory in 'buildRoot' containing the object artifacts. +buildDir :: Context -> FilePath +buildDir context = contextDir context -/- "build" + +-- | Path to the directory containing build artifacts of a given 'Context'. +buildPath :: Context -> Action FilePath +buildPath context = buildRoot <&> (-/- (buildDir context)) + +-- | Get the build path of the current 'Context'. +getBuildPath :: Expr Context b FilePath +getBuildPath = expr . buildPath =<< getContext diff --git a/src/Expression.hs b/src/Expression.hs index dc095e1075..8fe0f992b7 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -13,31 +13,29 @@ module Expression ( interpret, interpretInContext, -- * Convenient accessors - getBuildRoot, getContext, getPkgData, getPkgDataList, getOutputs, getInputs, - getInput, getOutput, + getBuildRoot, getContext, getOutputs, getInputs, + getInput, getOutput, getConfiguredCabalData, -- * Re-exports module Base, module Builder, module Context, - module GHC ) where import Base -import Builder +import {-# SOURCE #-} Builder import Context hiding (stage, package, way) import Expression.Type -import GHC import Hadrian.Expression hiding (Expr, Predicate, Args) -import Oracles.PackageData - --- | Get a value from the @package-data.mk@ file of the current context. -getPkgData :: (FilePath -> PackageData) -> Expr String -getPkgData key = expr . pkgData . key =<< getBuildPath - --- | Get a list of values from the @package-data.mk@ file of the current context. -getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String] -getPkgDataList key = expr . pkgDataList . key =<< getBuildPath +import Hadrian.Haskell.Cabal.Configured (ConfiguredCabal) +import Hadrian.Oracles.TextFile (readConfiguredCabalFile) + +-- | Get values from a configured cabal stage. +getConfiguredCabalData :: (ConfiguredCabal -> a) -> Expr a +getConfiguredCabalData key = do + ctx <- getContext + Just cabal <- expr (readConfiguredCabalFile ctx) + return $ key cabal -- | Is the build currently in the provided stage? stage :: Stage -> Predicate diff --git a/src/Expression/Type.hs b/src/Expression/Type.hs index 258f78e74b..8c5ede8f2b 100644 --- a/src/Expression/Type.hs +++ b/src/Expression/Type.hs @@ -1,10 +1,11 @@ module Expression.Type where -import Builder import Context.Type -import qualified Hadrian.Expression as H import Way.Type +import {-# SOURCE #-} Builder +import qualified Hadrian.Expression as H + -- | @Expr a@ is a computation that produces a value of type @Action a@ and can -- read parameters of the current build 'Target'. type Expr a = H.Expr Context Builder a diff --git a/src/GHC.hs b/src/GHC.hs index 2a87d68cca..7d7112e3c5 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -5,7 +5,7 @@ module GHC ( deepseq, deriveConstants, directory, filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, - integerSimple, iservBin, iservLib, libffi, mtl, parsec, parallel, pretty, + integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages, @@ -18,114 +18,12 @@ module GHC ( ) where import Base -import CommandLine import Context +import Flavour +import GHC.Packages import Oracles.Flag import Oracles.Setting - --- | These are all GHC packages we know about. Build rules will be generated for --- all of them. However, not all of these packages will be built. For example, --- package 'win32' is built only on Windows. 'defaultPackages' defines default --- conditions for building each package. Users can add their own packages and --- modify build default build conditions in "UserSettings". -ghcPackages :: [Package] -ghcPackages = - [ array, base, binary, bytestring, cabal, compareSizes, compiler, containers - , deepseq, deriveConstants, directory, filepath, genapply, genprimopcode - , ghc, ghcBoot, ghcBootTh, ghcCabal, ghcCompact, ghci, ghcPkg, ghcPrim - , ghcTags, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp - , integerSimple, iservBin, iservLib, libffi, mtl, parsec, parallel, pretty - , primitive, process, rts, runGhc, stm, templateHaskell, terminfo, text - , time, touchy, transformers, unlit, unix, win32, xhtml ] - --- TODO: Optimise by switching to sets of packages. -isGhcPackage :: Package -> Bool -isGhcPackage = (`elem` ghcPackages) - --- | Package definitions, see 'Package'. -array = hsLib "array" -base = hsLib "base" -binary = hsLib "binary" -bytestring = hsLib "bytestring" -cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" -compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" -compiler = hsTop "ghc" `setPath` "compiler" -containers = hsLib "containers" -deepseq = hsLib "deepseq" -deriveConstants = hsUtil "deriveConstants" -directory = hsLib "directory" -filepath = hsLib "filepath" -genapply = hsUtil "genapply" -genprimopcode = hsUtil "genprimopcode" -ghc = hsPrg "ghc-bin" `setPath` "ghc" -ghcBoot = hsLib "ghc-boot" -ghcBootTh = hsLib "ghc-boot-th" -ghcCabal = hsUtil "ghc-cabal" -ghcCompact = hsLib "ghc-compact" -ghci = hsLib "ghci" -ghcPkg = hsUtil "ghc-pkg" -ghcPrim = hsLib "ghc-prim" -ghcTags = hsUtil "ghctags" -ghcSplit = hsUtil "ghc-split" -haddock = hsUtil "haddock" -haskeline = hsLib "haskeline" -hsc2hs = hsUtil "hsc2hs" -hp2ps = cUtil "hp2ps" -hpc = hsLib "hpc" -hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" -integerGmp = hsLib "integer-gmp" -integerSimple = hsLib "integer-simple" --- iservBin = hsUtil "iserv" -- FIXME: See #507 -iservBin = hsPrg "iserv-bin" `setPath` "iserv" -iservLib = hsLib "libiserv" -libffi = cTop "libffi" -mtl = hsLib "mtl" -parsec = hsLib "parsec" -parallel = hsLib "parallel" -pretty = hsLib "pretty" -primitive = hsLib "primitive" -process = hsLib "process" -rts = cTop "rts" -runGhc = hsUtil "runghc" -stm = hsLib "stm" -templateHaskell = hsLib "template-haskell" -terminfo = hsLib "terminfo" -text = hsLib "text" -time = hsLib "time" -touchy = cUtil "touchy" -transformers = hsLib "transformers" -unlit = cUtil "unlit" -unix = hsLib "unix" -win32 = hsLib "Win32" -xhtml = hsLib "xhtml" - --- | Construct a Haskell library package, e.g. @array@. -hsLib :: PackageName -> Package -hsLib name = hsLibrary name ("libraries" -/- name) - --- | Construct a top-level Haskell library package, e.g. @compiler@. -hsTop :: PackageName -> Package -hsTop name = hsLibrary name name - --- | Construct a top-level C library package, e.g. @rts@. -cTop :: PackageName -> Package -cTop name = cLibrary name name - --- | Construct a top-level Haskell program package, e.g. @ghc@. -hsPrg :: PackageName -> Package -hsPrg name = hsProgram name name - --- | Construct a Haskell utility package, e.g. @haddock@. -hsUtil :: PackageName -> Package -hsUtil name = hsProgram name ("utils" -/- name) - --- | Construct a C utility package, e.g. @haddock@. -cUtil :: PackageName -> Package -cUtil name = cProgram name ("utils" -/- name) - --- | Amend a package path if it doesn't conform to a typical pattern. -setPath :: Package -> FilePath -> Package -setPath pkg path = pkg { pkgPath = path } +import Settings (flavour) -- | Packages that are built by default. You can change this in "UserSettings". defaultPackages :: Stage -> Action [Package] @@ -137,7 +35,6 @@ defaultPackages Stage3 = return [] stage0Packages :: Action [Package] stage0Packages = do win <- windowsHost - ios <- iosHost cross <- crossCompiling return $ [ binary , cabal @@ -149,7 +46,6 @@ stage0Packages = do , ghc , ghcBoot , ghcBootTh - , ghcCabal , ghci , ghcPkg , ghcTags @@ -161,15 +57,16 @@ stage0Packages = do , templateHaskell , text , transformers - , unlit ] - ++ [ terminfo | not win, not ios, not cross ] - ++ [ touchy | win ] + , unlit ] + ++ [ terminfo | not win, not cross ] + ++ [ touchy | win ] stage1Packages :: Action [Package] stage1Packages = do win <- windowsHost - intSimple <- cmdIntegerSimple + intLib <- integerLibrary =<< flavour libraries0 <- filter isLibrary <$> stage0Packages + cross <- crossCompiling return $ libraries0 -- Build all Stage0 libraries in Stage1 ++ [ array , base @@ -179,24 +76,27 @@ stage1Packages = do , directory , filepath , ghc - , ghcCabal , ghcCompact + , ghcPkg , ghcPrim , haskeline - , hpcBin , hsc2hs - , if intSimple then integerSimple else integerGmp + , intLib , pretty , process , rts - , runGhc , stm , time - , xhtml ] - ++ [ iservBin | not win ] - -- ++ [ iservLib | not win ] -- FIXME: See #507 - ++ [ unix | not win ] - ++ [ win32 | win ] + , unlit + , xhtml ] + ++ [ haddock | not cross ] + ++ [ runGhc | not cross ] + ++ [ hpcBin | not cross ] + -- ++ [ libiserv | not win, not cross ] + -- TODO: ^^^ fix this + ++ [ iservBin | not win, not cross ] + ++ [ unix | not win ] + ++ [ win32 | win ] stage2Packages :: Action [Package] stage2Packages = return [haddock] @@ -205,13 +105,17 @@ stage2Packages = return [haddock] -- assuming that the corresponding package's type is 'Program'. For example, GHC -- built in 'Stage0' is called @ghc-stage1@. If the given package is a -- 'Library', the function simply returns its name. -programName :: Context -> String -programName Context {..} - | package == ghc = "ghc-stage" ++ show (fromEnum stage + 1) - | package == hpcBin = "hpc" - | package == runGhc = "runhaskell" - | package == iservBin = "ghc-iserv" - | otherwise = pkgName package +programName :: Context -> Action String +programName Context {..} = do + cross <- crossCompiling + targetPlatform <- setting TargetPlatformFull + let prefix = if cross then targetPlatform ++ "-" else "" + in return $ prefix ++ case package of + p | p == ghc -> "ghc" + | p == hpcBin -> "hpc" + | p == runGhc -> "runhaskell" + | p == iservBin -> "ghc-iserv" + _ -> pkgName package -- | The build stage whose results are used when installing a package, or -- @Nothing@ if the package is not installed, e.g. because it is a user package. @@ -223,34 +127,20 @@ installStage pkg stages <- filterM (fmap (pkg `elem`) . defaultPackages) [Stage0 ..] return $ if null stages then Nothing else Just (maximum stages) --- | Is the program corresponding to a given context built 'inplace', i.e. in --- the @inplace/bin@ directory? For most programs, only their /latest/ build --- stages are built 'inplace'. The only exception is the GHC itself, which is --- built 'inplace' in all stages. The function returns @False@ for libraries and --- all user packages. -isBuiltInplace :: Context -> Action Bool -isBuiltInplace Context {..} - | isLibrary package = return False - | not (isGhcPackage package) = return False - | package == ghc = return True - | otherwise = (Just stage ==) <$> installStage package - -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context@Context {..} = do - path <- buildPath context - inplace <- isBuiltInplace context - let contextPath = if inplace then inplacePath else path - return $ contextPath -/- programName context <.> exe - where - inplacePath | package `elem` [touchy, unlit, iservBin] = inplaceLibBinPath - | otherwise = inplaceBinPath + path <- stageBinPath stage + pgm <- programName context + return $ path -/- pgm <.> exe -- | Some contexts are special: their packages do not have @.cabal@ metadata or -- we cannot run @ghc-cabal@ on them, e.g. because the latter hasn't been built -- yet (this is the case with the 'ghcCabal' package in 'Stage0'). nonCabalContext :: Context -> Bool -nonCabalContext Context {..} = (package `elem` [hp2ps, rts, touchy, unlit]) +nonCabalContext Context {..} = (package `elem` [ hp2ps + , touchy + ]) || package == ghcCabal && stage == Stage0 -- | Some program packages should not be linked with Haskell main function. @@ -266,7 +156,20 @@ autogenPath context@Context {..} | package == iservBin = autogen "build/iserv" | otherwise = autogen $ "build" -/- pkgName package where - autogen dir = buildPath context <&> (-/- dir -/- "autogen") + autogen dir = contextPath context <&> (-/- dir -/- "autogen") + +-- ref: mk/config.mk +-- | Command line tool for stripping. +stripCmdPath :: Action FilePath +stripCmdPath = do + targetPlatform <- setting TargetPlatform + top <- topDirectory + case targetPlatform of + "x86_64-unknown-mingw32" -> + return (top -/- "inplace/mingw/bin/strip.exe") + "arm-unknown-linux" -> + return ":" -- HACK: from the make-based system, see the ref above + _ -> return "strip" buildDll0 :: Context -> Action Bool buildDll0 Context {..} = do diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs new file mode 100644 index 0000000000..0c6d218b52 --- /dev/null +++ b/src/GHC/Packages.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +module GHC.Packages where + +import Hadrian.Package +import Hadrian.Utilities + +-- | These are all GHC packages we know about. Build rules will be generated for +-- all of them. However, not all of these packages will be built. For example, +-- package 'win32' is built only on Windows. 'defaultPackages' defines default +-- conditions for building each package. Users can add their own packages and +-- modify build default build conditions in "UserSettings". +ghcPackages :: [Package] +ghcPackages = + [ array, base, binary, bytestring, cabal, compareSizes, compiler, containers + , deepseq, deriveConstants, directory, filepath, genapply, genprimopcode + , ghc, ghcBoot, ghcBootTh, ghcCompact, ghci, ghcPkg, ghcPrim + , ghcTags, haddock, haskeline, hsc2hs, hp2ps, 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 --, libiserv + ] + +-- TODO: Optimise by switching to sets of packages. +isGhcPackage :: Package -> Bool +isGhcPackage = (`elem` ghcPackages) + +-- | Package definitions, see 'Package'. +array = hsLib "array" +base = hsLib "base" +binary = hsLib "binary" +bytestring = hsLib "bytestring" +cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" +compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" +compiler = hsTop "ghc" `setPath` "compiler" +containers = hsLib "containers" +deepseq = hsLib "deepseq" +deriveConstants = hsUtil "deriveConstants" +directory = hsLib "directory" +filepath = hsLib "filepath" +genapply = hsUtil "genapply" +genprimopcode = hsUtil "genprimopcode" +ghc = hsPrg "ghc-bin" `setPath` "ghc" +ghcBoot = hsLib "ghc-boot" +ghcBootTh = hsLib "ghc-boot-th" +ghcCabal = hsUtil "ghc-cabal" +ghcCompact = hsLib "ghc-compact" +ghci = hsLib "ghci" +ghcPkg = hsUtil "ghc-pkg" +ghcPrim = hsLib "ghc-prim" +ghcTags = hsUtil "ghctags" +ghcSplit = hsUtil "ghc-split" +haddock = hsUtil "haddock" +haskeline = hsLib "haskeline" +hsc2hs = hsUtil "hsc2hs" +hp2ps = hsUtil "hp2ps" +hpc = hsLib "hpc" +hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" +integerGmp = hsLib "integer-gmp" +integerSimple = hsLib "integer-simple" +iservBin = hsUtil "iserv-bin" `setPath` "iserv" +libffi = cTop "libffi" +mtl = hsLib "mtl" +parsec = hsLib "parsec" +parallel = hsLib "parallel" +pretty = hsLib "pretty" +primitive = hsLib "primitive" +process = hsLib "process" +rts = cTop "rts" +runGhc = hsUtil "runghc" +stm = hsLib "stm" +templateHaskell = hsLib "template-haskell" +terminfo = hsLib "terminfo" +text = hsLib "text" +time = hsLib "time" +touchy = hsUtil "touchy" +transformers = hsLib "transformers" +unlit = hsUtil "unlit" +unix = hsLib "unix" +win32 = hsLib "Win32" +xhtml = hsLib "xhtml" +-- libiserv = hsLib "libiserv" + + +-- | Construct a Haskell library package, e.g. @array@. +hsLib :: PackageName -> Package +hsLib name = hsLibrary name ("libraries" -/- name) + +-- | Construct a top-level Haskell library package, e.g. @compiler@. +hsTop :: PackageName -> Package +hsTop name = hsLibrary name name + +-- | Construct a top-level C library package, e.g. @rts@. +cTop :: PackageName -> Package +cTop name = cLibrary name name + +-- | Construct a top-level Haskell program package, e.g. @ghc@. +hsPrg :: PackageName -> Package +hsPrg name = hsProgram name name + +-- | Construct a Haskell utility package, e.g. @haddock@. +hsUtil :: PackageName -> Package +hsUtil name = hsProgram name ("utils" -/- name) + +-- | Amend a package path if it doesn't conform to a typical pattern. +setPath :: Package -> FilePath -> Package +setPath pkg path = pkg { pkgPath = path } diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs index 38810c7170..2c3ceb9ef3 100644 --- a/src/Hadrian/Builder.hs +++ b/src/Hadrian/Builder.hs @@ -14,7 +14,7 @@ module Hadrian.Builder ( Builder (..), BuildInfo (..), needBuilder, runBuilder, runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions, - getBuilderPath, builderEnvironment + getBuilderPath, builderEnvironment, askWithResources ) where import Data.List @@ -42,6 +42,11 @@ class ShakeValue b => Builder b where -- | The path to a builder. builderPath :: b -> Action FilePath + -- | Ask the builder for information. + -- E.g. ask @ghc-pkg@ for package dependencies + -- capture the @stdout@ result and return it. + askBuilderWith :: b -> BuildInfo -> Action String + -- | Runtime dependencies of a builder. For example, on Windows GHC requires -- the utility @touchy.exe@ to be avilable on a specific path. runtimeDependencies :: b -> Action [FilePath] @@ -89,25 +94,37 @@ build = buildWith [] [] buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action () buildWithResources rs = buildWith rs [] +askWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action String +askWithResources rs = askWith rs [] + -- | Like 'build' but passes given options to Shake's 'cmd'. buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action () buildWithCmdOptions = buildWith [] -buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action () -buildWith rs opts target args = do +doWith :: (Builder b, ShakeValue c) + => (b -> BuildInfo -> Action a) + -> (Target c b -> Action ()) + -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a +doWith f info rs opts target args = do needBuilder (builder target) argList <- interpret target args trackArgsHash target -- Rerun the rule if the hash of argList has changed. - putInfo target + info target verbose <- interpret target verboseCommand let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly - quietlyUnlessVerbose $ runBuilderWith (builder target) $ + quietlyUnlessVerbose $ f (builder target) $ BuildInfo { buildArgs = argList , buildInputs = inputs target , buildOutputs = outputs target , buildOptions = opts , buildResources = rs } +buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action () +buildWith = doWith runBuilderWith runInfo + +askWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action String +askWith = doWith askBuilderWith askInfo + -- | Print out information about the command being executed. putInfo :: Show b => Target c b -> Action () putInfo t = putProgressInfo =<< renderAction @@ -119,6 +136,26 @@ putInfo t = putProgressInfo =<< renderAction digest [x] = x digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)" +-- | Print out information about the command being executed. +runInfo :: Show b => Target c b -> Action () +runInfo t = putProgressInfo =<< renderAction + ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo. + (digest $ inputs t) + (digest $ outputs t) + where + digest [] = "none" + digest [x] = x + digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)" + +askInfo :: Show b => Target c b -> Action () +askInfo t = putProgressInfo =<< renderActionNoOutput + ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo. + (digest $ inputs t) + where + digest [] = "none" + digest [x] = x + digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)" + -- | Get the path to the current builder. getBuilderPath :: Builder b => b -> Expr c b FilePath getBuilderPath = expr . builderPath diff --git a/src/Hadrian/Haskell/Cabal.hs b/src/Hadrian/Haskell/Cabal.hs index ab5f334f9b..2baee600e6 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -15,30 +15,32 @@ module Hadrian.Haskell.Cabal ( import Development.Shake -import Hadrian.Haskell.Cabal.Parse +import Context.Type +import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal.Configured as CC import Hadrian.Package import Hadrian.Oracles.TextFile -- | Read a Cabal file and return the package version. The Cabal file is tracked. -pkgVersion :: FilePath -> Action String -pkgVersion cabalFile = version <$> readCabalFile cabalFile +pkgVersion :: Context -> Action (Maybe String) +pkgVersion = fmap (fmap C.version) . readCabalFile -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0@. -- The Cabal file is tracked. -pkgIdentifier :: FilePath -> Action String -pkgIdentifier cabalFile = do - cabal <- readCabalFile cabalFile - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal +pkgIdentifier :: Context -> Action String +pkgIdentifier ctx = do + Just cabal <- readCabalFile ctx + return $ if null (C.version cabal) + then C.name cabal + else C.name cabal ++ "-" ++ C.version cabal -- | Read a Cabal file and return the sorted list of the package dependencies. -- The current version does not take care of Cabal conditionals and therefore -- returns a crude overapproximation of actual dependencies. The Cabal file is -- tracked. -pkgDependencies :: FilePath -> Action [PackageName] -pkgDependencies cabalFile = dependencies <$> readCabalFile cabalFile +pkgDependencies :: Context -> Action (Maybe [PackageName]) +pkgDependencies = fmap (fmap CC.dependencies) . readConfiguredCabalFile -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. -pkgSynopsis :: FilePath -> Action String -pkgSynopsis cabalFile = synopsis <$> readCabalFile cabalFile +pkgSynopsis :: Context -> Action (Maybe String) +pkgSynopsis = fmap (fmap C.synopsis) . readCabalFile diff --git a/src/Hadrian/Haskell/Cabal/Configured.hs b/src/Hadrian/Haskell/Cabal/Configured.hs new file mode 100644 index 0000000000..e20faae30e --- /dev/null +++ b/src/Hadrian/Haskell/Cabal/Configured.hs @@ -0,0 +1,55 @@ +module Hadrian.Haskell.Cabal.Configured where + +import Development.Shake.Classes +import Hadrian.Package.Type +import GHC.Generics + +data ConfiguredCabal = ConfiguredCabal + { dependencies :: [PackageName] + , name :: PackageName + , version :: String + -- , packageDesc :: C.PackageDescription + -- * used to be pkg Data + , componentId :: String + , modules :: [String] + , otherModules :: [String] + , synopsis :: String + , description :: String + , srcDirs :: [String] + , deps :: [String] + , depIpIds :: [String] + , depNames :: [String] + , depCompIds :: [String] + , includeDirs :: [String] + , includes :: [String] + , installIncludes :: [String] -- TODO: do we need this one? + , extraLibs :: [String] + , extraLibDirs :: [String] + , asmSrcs :: [String] + , cSrcs :: [String] + , cmmSrcs :: [String] + , dataFiles :: [String] + , hcOpts :: [String] + , asmOpts :: [String] + , ccOpts :: [String] + , cmmOpts :: [String] + , cppOpts :: [String] + , ldOpts :: [String] + , depIncludeDirs :: [String] + , depCcOpts :: [String] + , depLdOpts :: [String] + , buildGhciLib :: Bool + } deriving (Eq, Read, Show, Typeable, Generic) + +instance Binary ConfiguredCabal + +instance Hashable ConfiguredCabal where + hashWithSalt salt = hashWithSalt salt . show + +instance NFData ConfiguredCabal where + rnf (ConfiguredCabal a b c d e f g h i j k l m n o p q r s t u v w x z y + aa ab ac ad ae af) + = a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` g `seq` h `seq` i `seq` j + `seq` k `seq` l `seq` m `seq` n `seq` o `seq` p `seq` q `seq` r `seq` s `seq` t + `seq` u `seq` v `seq` w `seq` x `seq` y `seq` z `seq` aa `seq` ab `seq` ac `seq` ad + `seq` ae `seq` af `seq` () diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index bd7b6abe1f..f899ba1896 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -8,36 +8,287 @@ -- -- Extracting Haskell package metadata stored in Cabal files. ----------------------------------------------------------------------------- -module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal) where +module Hadrian.Haskell.Cabal.Parse + ( ConfiguredCabal (..), parseCabal, parseConfiguredCabal + , parseCabalPkgId + , configurePackage, copyPackage, registerPackage + ) where import Data.List.Extra import Development.Shake +import qualified Distribution.ModuleName as ModuleName import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C +import qualified Distribution.PackageDescription.Configuration as C import qualified Distribution.PackageDescription.Parsec as C +import qualified Distribution.Simple.Compiler as C (packageKeySupported, languageToFlags, extensionsToFlags, compilerInfo) +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.Program.Db as Db +import qualified Distribution.Simple as Hooks (simpleUserHooks, autoconfUserHooks, defaultMainWithHooksNoReadArgs, compilerFlavor, CompilerFlavor(GHC)) +import qualified Distribution.Simple.UserHooks as Hooks +import qualified Distribution.Simple.Program.Builtin as C +import qualified Distribution.Simple.Utils as C (findHookedPackageDesc) +import qualified Distribution.Simple.Program.Types as C (programDefaultArgs, programOverrideArgs) +import qualified Distribution.Simple.Configure as C (getPersistBuildConfig) +import qualified Distribution.Simple.Build as C (initialBuildSteps) +import qualified Distribution.Types.ComponentRequestedSpec as C (defaultComponentRequestedSpec) +import qualified Distribution.InstalledPackageInfo as Installed +import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Distribution.Types.LocalBuildInfo as C import qualified Distribution.Text as C import qualified Distribution.Types.CondTree as C +import qualified Distribution.Types.MungedPackageId as C (mungedName) import qualified Distribution.Verbosity as C -import Hadrian.Haskell.Cabal.Type - --- | Parse a Cabal file. -parseCabal :: FilePath -> IO Cabal -parseCabal file = do - gpd <- liftIO $ C.readGenericPackageDescription C.silent file - let pd = C.packageDescription gpd - pkgId = C.package pd - name = C.unPackageName (C.pkgName pkgId) - version = C.display (C.pkgVersion pkgId) - libDeps = collectDeps (C.condLibrary gpd) - exeDeps = map (collectDeps . Just . snd) (C.condExecutables gpd) - allDeps = concat (libDeps : exeDeps) - sorted = sort [ C.unPackageName p | C.Dependency p _ <- allDeps ] - deps = nubOrd sorted \\ [name] - return $ Cabal deps name (C.synopsis pd) version - -collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency] -collectDeps Nothing = [] -collectDeps (Just (C.CondNode _ deps ifs)) = deps ++ concatMap f ifs - where - f (C.CondBranch _ t mt) = collectDeps (Just t) ++ collectDeps mt +import Base +import Builder hiding (Builder) +import Context -- .Type +import Flavour (args) +import GHC.Packages (rts) +import Hadrian.Expression +import Hadrian.Haskell.Cabal.Type ( Cabal( Cabal ) ) +import Hadrian.Haskell.Cabal.Configured +import Hadrian.Oracles.TextFile +import Hadrian.Target +import Settings +import Oracles.Setting + +parseCabalPkgId :: FilePath -> IO String +parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file + + +biModules :: C.PackageDescription -> (C.BuildInfo, [ModuleName.ModuleName]) +biModules pd = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.library pd) + ++ (map exeBiModules $ C.executables pd) + , C.buildable bi ] + where libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib) + exeBiModules exe = (C.buildInfo exe + , if isHaskell (C.modulePath exe) -- if "main-is: ..." is not a .hs or .lhs file, do + -- not inject "Main" into the modules. This does + -- not respect "-main-is" ghc-arguments! See GHC.hs + -- in Distribution.Simple.GHC from Cabal for the glory + -- details. + then ModuleName.main : C.exeModules exe + else C.exeModules exe) + go [] = error "no buildable component found" + go [x] = x + go _ = error "can not handle more than one buildinfo yet!" + isHaskell fp = takeExtension fp `elem` [".hs", ".lhs"] + +parseCabal :: Context -> Action Cabal +parseCabal context@Context {..} = do + let (Just file) = pkgCabalFile package + + -- read the package description from the cabal file + gpd <- liftIO $ C.readGenericPackageDescription C.verbose file + + -- configure the package with the ghc compiler for this stage. + hcPath <- builderPath' (Ghc CompileHs stage) + (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb + + + flagList <- interpret (target context (CabalFlags stage) [] []) =<< args <$> flavour + let flags = foldr addFlag mempty flagList + where addFlag :: String -> C.FlagAssignment -> C.FlagAssignment + addFlag ('-':name) = C.insertFlagAssignment (C.mkFlagName name) False + addFlag ('+':name) = C.insertFlagAssignment (C.mkFlagName name) True + addFlag name = C.insertFlagAssignment (C.mkFlagName name) True + + let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (C.compilerInfo compiler) [] gpd + -- depPkgs are all those packages that are needed. These should be found in + -- the known build packages. Even if they are not build in this stage. + let depPkgs = map (findPackageByName' . C.unPackageName . C.depPkgName) + . flip C.enabledBuildDepends C.defaultComponentRequestedSpec $ pd + where findPackageByName' p = case findPackageByName p of + Just p' -> p' + Nothing -> error $ "Failed to find package: " ++ show p + return $ Cabal (C.unPackageName . C.pkgName . C.package $ pd) + (C.display . C.pkgVersion . C.package $ pd) + (C.synopsis pd) + gpd + pd + depPkgs + +configurePackage :: Context -> Action () +configurePackage context@Context {..} = do + Just (Cabal _ _ _ gpd _pd depPkgs) <- readCabalFile context + + -- Stage packages are those we have in this stage. + stagePkgs <- stagePackages stage + -- we'll need those package in our package database. + need =<< sequence [ pkgConfFile (context { package = pkg }) | pkg <- depPkgs, pkg `elem` stagePkgs ] + + -- figure out what hooks we need. + hooks <- case C.buildType (C.flattenPackageDescription gpd) of + C.Configure -> pure Hooks.autoconfUserHooks + -- time has a "Custom" Setup.hs, but it's actually Configure + -- plus a "./Setup test" hook. However, Cabal is also + -- "Custom", but doesn't have a configure script. + C.Custom -> + do configureExists <- doesFileExist (replaceFileName (unsafePkgCabalFile package) "configure") + if configureExists + then pure Hooks.autoconfUserHooks + else pure Hooks.simpleUserHooks + -- not quite right, but good enough for us: + _ | package == rts -> + -- don't try to do post conf validation for rts. + -- this will simply not work, due to the ld-options, + -- and the Stg.h. + pure $ Hooks.simpleUserHooks { Hooks.postConf = \_ _ _ _ -> return () } + | otherwise -> pure Hooks.simpleUserHooks + + + case pkgCabalFile package of + Nothing -> error "No a cabal package!" + Just _ -> do + -- compute the flaglist + flagList <- interpret (target context (CabalFlags stage) [] []) =<< args <$> flavour + -- compute the cabal conf args + argList <- interpret (target context (GhcCabal Conf stage) [] []) =<< args <$> flavour + liftIO $ do + Hooks.defaultMainWithHooksNoReadArgs hooks gpd (argList ++ ["--flags=" ++ unwords flagList]) + +-- XXX: move this somewhere else. This is logic from ghc-cabal +copyPackage :: Context -> Action () +copyPackage context@Context {..} = do + -- original invocation + Just (Cabal _ _ _ gpd _ _) <- readCabalFile context + + top <- topDirectory + ctxPath <- (top -/-) <$> Context.contextPath context + pkgDbPath <- (top -/-) <$> packageDbPath stage + + let userHooks = Hooks.autoconfUserHooks + copyHooks = userHooks + hooks = copyHooks + + liftIO $ Hooks.defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath] + +registerPackage :: Context -> Action () +registerPackage context@Context {..} = do + top <- topDirectory + ctxPath <- (top -/-) <$> Context.contextPath context + Just (Cabal _ _ _ gpd _ _) <- readCabalFile context + let userHooks = Hooks.autoconfUserHooks + regHooks = userHooks + + liftIO $ + Hooks.defaultMainWithHooksNoReadArgs regHooks gpd ["register", "--builddir", ctxPath] + +-- | Parse a ConfiguredCabal file. +parseConfiguredCabal :: Context -> Action ConfiguredCabal +parseConfiguredCabal context@Context {..} = do + -- XXX: This is conceptually wrong! + -- We should use the gpd, and + -- the flagAssignment and compiler, hostPlatform, ... information + -- from the lbi. And then compute the finaliz PD (flags, satisfiable dependencies, platform, compiler info, deps, gpd.) + -- + -- let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (compilerInfo compiler) [] gpd + -- + -- However when using the new-build path's this might change. + + Just (Cabal _ _ _ _gpd pd _depPkgs) <- readCabalFile context + + cPath <- Context.contextPath context + need [cPath -/- "setup-config"] + + lbi <- liftIO $ C.getPersistBuildConfig cPath + + -- XXX: move this into it's own rule for build/autogen/cabal_macros.h, and build/autogen/Path_*.hs + -- and "need" them here. + -- create the cabal_macros.h, ... + -- Note: the `cPath` is ignored. The path that's used is the `buildDir` path from the local build info (lbi). + pdi <- liftIO $ getHookedBuildInfo (pkgPath package) + let pd' = C.updatePackageDescription pdi pd + lbi' = lbi { C.localPkgDescr = pd' } + liftIO $ C.initialBuildSteps cPath pd' lbi' C.silent + + let extDeps = C.externalPackageDeps lbi' + deps = map (C.display . snd) extDeps + dep_direct = map (fromMaybe (error "dep_keys failed") + . PackageIndex.lookupUnitId (C.installedPkgs lbi') + . fst) extDeps + dep_ipids = map (C.display . Installed.installedUnitId) dep_direct + + Just ghcProg = Db.lookupProgram C.ghcProgram (C.withPrograms lbi') + + dep_pkgs = PackageIndex.topologicalOrder (packageHacks (C.installedPkgs lbi')) + forDeps f = concatMap f dep_pkgs + + -- copied from Distribution.Simple.PreProcess.ppHsc2Hs + packageHacks = case Hooks.compilerFlavor (C.compiler lbi') of + Hooks.GHC | C.pkgName (C.package pd') /= (C.mkPackageName "rts") -> hackRtsPackage + _ -> id + -- We don't link in the actual Haskell libraries of our + -- dependencies, so the -u flags in the ldOptions of the rts + -- package mean linking fails on OS X (it's ld is a tad + -- stricter than gnu ld). Thus we remove the ldOptions for + -- GHC's rts package: + hackRtsPackage index | null (PackageIndex.allPackages index) = index + -- ^ do not hack the empty index + hackRtsPackage index = + case PackageIndex.lookupPackageName index (C.mkPackageName "rts") of + [(_,[rts])] -> + PackageIndex.insert rts{ + Installed.ldOptions = [], + Installed.libraryDirs = filter (not . ("gcc-lib" `isSuffixOf`)) (Installed.libraryDirs rts)} index + -- GHC <= 6.12 had $topdir/gcc-lib in their + -- library-dirs for the rts package, which causes + -- problems when we try to use the in-tree mingw, + -- due to accidentally picking up the incompatible + -- libraries there. So we filter out gcc-lib from + -- the RTS's library-dirs here. + _ -> error "No (or multiple) ghc rts package is registered!!" + + in return $ ConfiguredCabal + { dependencies = deps + , name = C.unPackageName . C.pkgName . C.package $ pd' + , version = C.display . C.pkgVersion . C.package $ pd' + -- , packageDesc = pd + , componentId = C.localCompatPackageKey lbi' + , modules = map C.display . snd . biModules $ pd' + , otherModules = map C.display . C.otherModules . fst . biModules $ pd' + , synopsis = C.synopsis pd' + , description = C.description pd' + , srcDirs = C.hsSourceDirs . fst . biModules $ pd' + , deps = deps + , depIpIds = dep_ipids + , depNames = map (C.display . C.mungedName . snd) extDeps + , depCompIds = if C.packageKeySupported (C.compiler lbi') + then dep_ipids + else deps + , includeDirs = C.includeDirs . fst . biModules $ pd' + , includes = C.includes . fst . biModules $ pd' + , installIncludes = C.installIncludes . fst . biModules $ pd' + , extraLibs = C.extraLibs . fst . biModules $ pd' + , extraLibDirs = C.extraLibDirs . fst . biModules $ pd' + , asmSrcs = C.asmSources . fst . biModules $ pd' + , cSrcs = C.cSources . fst . biModules $ pd' + , cmmSrcs = C.cmmSources . fst . biModules $ pd' + , dataFiles = C.dataFiles pd' + , hcOpts = C.programDefaultArgs ghcProg + ++ (C.hcOptions Hooks.GHC . fst . biModules $ pd') + ++ C.languageToFlags (C.compiler lbi') (C.defaultLanguage . fst . biModules $ pd') + ++ C.extensionsToFlags (C.compiler lbi') (C.usedExtensions . fst . biModules $ pd') + ++ C.programOverrideArgs ghcProg + , asmOpts = C.asmOptions . fst . biModules $ pd' + , ccOpts = C.ccOptions . fst . biModules $ pd' + , cmmOpts = C.cmmOptions . fst . biModules $ pd' + , cppOpts = C.cppOptions . fst . biModules $ pd' + , ldOpts = C.ldOptions . fst . biModules $ pd' + , depIncludeDirs = forDeps Installed.includeDirs + , depCcOpts = forDeps Installed.ccOptions + , depLdOpts = forDeps Installed.ldOptions + , buildGhciLib = C.withGHCiLib lbi' + } + +getHookedBuildInfo :: FilePath -> IO C.HookedBuildInfo +getHookedBuildInfo baseDir = do + -- TODO: We should probably better generate this in the + -- build dir, rather then in the base dir? However + -- `configure` is run in the baseDir. + + maybe_infoFile <- C.findHookedPackageDesc baseDir + case maybe_infoFile of + Nothing -> return C.emptyHookedBuildInfo + Just infoFile -> C.readHookedBuildInfo C.silent infoFile diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs-boot b/src/Hadrian/Haskell/Cabal/Parse.hs-boot new file mode 100644 index 0000000000..d9c7f97b8c --- /dev/null +++ b/src/Hadrian/Haskell/Cabal/Parse.hs-boot @@ -0,0 +1,9 @@ +module Hadrian.Haskell.Cabal.Parse where + +import Context.Type (Context) +import Development.Shake (Action) +import Hadrian.Haskell.Cabal.Type (Cabal) +import Hadrian.Haskell.Cabal.Configured (ConfiguredCabal) + +parseCabal :: Context -> Action Cabal +parseConfiguredCabal :: Context -> Action ConfiguredCabal diff --git a/src/Hadrian/Haskell/Cabal/Type.hs b/src/Hadrian/Haskell/Cabal/Type.hs index df3255ffd2..5aafa742c1 100644 --- a/src/Hadrian/Haskell/Cabal/Type.hs +++ b/src/Hadrian/Haskell/Cabal/Type.hs @@ -1,23 +1,24 @@ module Hadrian.Haskell.Cabal.Type where import Development.Shake.Classes +import Distribution.PackageDescription (GenericPackageDescription, PackageDescription) +import GHC.Generics import Hadrian.Package.Type --- TODO: Use fine-grain tracking instead of tracking the whole Cabal file. -- | Haskell package metadata extracted from a Cabal file. data Cabal = Cabal - { dependencies :: [PackageName] - , name :: PackageName - , synopsis :: String - , version :: String - } deriving (Eq, Read, Show, Typeable) + { name :: PackageName + , version :: String + , synopsis :: String + , genericPackageDescription :: GenericPackageDescription + , packageDescription :: PackageDescription + , packageDependencies :: [Package] + } deriving (Eq, Show, Typeable, Generic) -instance Binary Cabal where - put = put . show - get = fmap read get +instance Binary Cabal instance Hashable Cabal where hashWithSalt salt = hashWithSalt salt . show instance NFData Cabal where - rnf (Cabal a b c d) = a `seq` b `seq` c `seq` d `seq` () + rnf (Cabal a b c d e f) = a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` () diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index 6d4f048c7d..57d8c94a80 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -13,7 +13,7 @@ module Hadrian.Oracles.TextFile ( readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, - readCabalFile, textFileOracle + readCabalFile, readConfiguredCabalFile, textFileOracle ) where import Control.Monad @@ -23,16 +23,25 @@ import Development.Shake import Development.Shake.Classes import Development.Shake.Config -import Hadrian.Haskell.Cabal.Parse +import Context.Type +import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal.Configured +import {-# SOURCE #-} Hadrian.Haskell.Cabal.Parse +import Hadrian.Package import Hadrian.Utilities +import Stage newtype TextFile = TextFile FilePath deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult TextFile = String -newtype CabalFile = CabalFile FilePath +newtype CabalFile = CabalFile Context deriving (Binary, Eq, Hashable, NFData, Show, Typeable) -type instance RuleResult CabalFile = Cabal +type instance RuleResult CabalFile = Maybe Cabal + +newtype ConfiguredCabalFile = ConfiguredCabalFile Context + deriving (Binary, Eq, Hashable, NFData, Show, Typeable) +type instance RuleResult ConfiguredCabalFile = Maybe ConfiguredCabal newtype KeyValue = KeyValue (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -90,9 +99,12 @@ lookupDependencies depFile file = do Just (source : files) -> return (source, files) -- | Read and parse a @.cabal@ file, caching and tracking the result. -readCabalFile :: FilePath -> Action Cabal +readCabalFile :: Context -> Action (Maybe Cabal) readCabalFile = askOracle . CabalFile +readConfiguredCabalFile :: Context -> Action (Maybe ConfiguredCabal) +readConfiguredCabalFile = askOracle . ConfiguredCabalFile + -- | This oracle reads and parses text files to answer 'readTextFile' and -- 'lookupValue' queries, as well as their derivatives, tracking the results. textFileOracle :: Rules () @@ -116,8 +128,22 @@ textFileOracle = do return $ Map.fromList [ (key, values) | (key:values) <- contents ] void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file - cabal <- newCache $ \file -> do - need [file] - putLoud $ "| CabalFile oracle: reading " ++ quote file ++ "..." - liftIO $ parseCabal file - void $ addOracle $ \(CabalFile file) -> cabal file + cabal <- newCache $ \(ctx@Context {..}) -> do + case pkgCabalFile package of + Just file -> do + need [file] + putLoud $ "| CabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..." + Just <$> parseCabal ctx + Nothing -> return Nothing + + void $ addOracle $ \(CabalFile ctx) -> cabal ctx + + confCabal <- newCache $ \(ctx@Context {..}) -> do + case pkgCabalFile package of + Just file -> do + need [file] + putLoud $ "| ConfiguredCabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..." + Just <$> parseConfiguredCabal ctx + Nothing -> return Nothing + + void $ addOracle $ \(ConfiguredCabalFile ctx) -> confCabal ctx diff --git a/src/Hadrian/Package.hs b/src/Hadrian/Package.hs index ffd5d38091..8b5a957b10 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -63,6 +63,7 @@ isCPackage _ = False -- | Is this a Haskell package? isHsPackage :: Package -> Bool isHsPackage (Package Haskell _ _ _) = True +isHsPackage (Package _ _ "rts" _) = True isHsPackage _ = False -- | The path to the Cabal file of a Haskell package, e.g. @ghc/ghc-bin.cabal@, diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index b775be2e89..4ef0970b59 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -24,7 +24,7 @@ module Hadrian.Utilities ( BuildProgressColour, mkBuildProgressColour, putBuild, SuccessColour, mkSuccessColour, putSuccess, ProgressInfo (..), putProgressInfo, - renderAction, renderProgram, renderLibrary, renderBox, renderUnicorn, + renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn, -- * Miscellaneous (<&>), (%%>), cmdLineLengthLimit, @@ -179,7 +179,7 @@ userSettingRules defaultValue = do extra <- shakeExtra <$> getShakeOptionsRules return $ lookupExtra defaultValue extra -newtype BuildRoot = BuildRoot FilePath deriving Typeable +newtype BuildRoot = BuildRoot FilePath deriving (Typeable, Eq, Show) -- | All build results are put into the 'buildRoot' directory. buildRoot :: Action FilePath @@ -388,6 +388,18 @@ renderAction what input output = do i = unifyPath input o = unifyPath output +-- | Render an action. +renderActionNoOutput :: String -> FilePath -> Action String +renderActionNoOutput what input = do + progressInfo <- userSetting Brief + return $ case progressInfo of + None -> "" + Brief -> "| " ++ what ++ ": " ++ i + Normal -> renderBox [ what, " input: " ++ i ] + Unicorn -> renderUnicorn [ what, " input: " ++ i ] + where + i = unifyPath input + -- | Render the successful build of a program. renderProgram :: String -> String -> Maybe String -> String renderProgram name bin synopsis = renderBox $ diff --git a/src/Main.hs b/src/Main.hs index 52af0adf7c..c206bfc9ed 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,7 @@ import qualified Environment import qualified Rules import qualified Rules.Clean import qualified Rules.Documentation -import qualified Rules.Install +-- import qualified Rules.Install import qualified Rules.SourceDist import qualified Rules.Selftest import qualified Rules.Test @@ -23,10 +23,9 @@ main = do argsMap <- CommandLine.cmdLineArgsMap let extra = insertExtra UserSettings.buildProgressColour $ insertExtra UserSettings.successColour - $ insertExtra UserSettings.userBuildRoot $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap - BuildRoot buildRoot = UserSettings.userBuildRoot + BuildRoot buildRoot = CommandLine.lookupBuildRoot argsMap rebuild = [ (RebuildLater, buildRoot -/- "stage0//*") | CommandLine.lookupFreeze1 argsMap ] @@ -45,7 +44,7 @@ main = do Rules.buildRules Rules.Documentation.documentationRules Rules.Clean.cleanRules - Rules.Install.installRules + -- Rules.Install.installRules Rules.oracleRules Rules.Selftest.selftestRules Rules.SourceDist.sourceDistRules diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index c7175dbc1c..cbf8a69397 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -8,8 +8,9 @@ import qualified Data.HashMap.Strict as Map import Base import Builder import Context +import Expression import GHC -import Oracles.PackageData +import Hadrian.Haskell.Cabal.Configured as ConfCabal newtype ModuleFiles = ModuleFiles (Stage, Package) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -26,19 +27,19 @@ haskellExtensions :: [String] haskellExtensions = [".hs", ".lhs"] -- | Non-Haskell source extensions and corresponding builders. -otherExtensions :: [(String, Builder)] -otherExtensions = [ (".x" , Alex ) - , (".y" , Happy ) - , (".ly" , Happy ) - , (".hsc", Hsc2Hs) ] +otherExtensions :: Stage -> [(String, Builder)] +otherExtensions stage = [ (".x" , Alex ) + , (".y" , Happy ) + , (".ly" , Happy ) + , (".hsc", Hsc2Hs stage) ] -- | We match the following file patterns when looking for module files. -moduleFilePatterns :: [FilePattern] -moduleFilePatterns = map ("*" ++) $ haskellExtensions ++ map fst otherExtensions +moduleFilePatterns :: Stage -> [FilePattern] +moduleFilePatterns stage = map ("*" ++) $ haskellExtensions ++ map fst (otherExtensions stage) -- | Given a FilePath determine the corresponding builder. -determineBuilder :: FilePath -> Maybe Builder -determineBuilder file = lookup (takeExtension file) otherExtensions +determineBuilder :: Stage -> FilePath -> Maybe Builder +determineBuilder stage file = lookup (takeExtension file) (otherExtensions stage) -- | Given a module name extract the directory and file name, e.g.: -- @@ -71,7 +72,7 @@ findGenerator Context {..} file = do maybeSource <- askOracle $ Generator (stage, package, file) return $ do source <- maybeSource - builder <- determineBuilder source + builder <- determineBuilder stage source return (source, builder) -- | Find all Haskell source files for a given 'Context'. @@ -88,10 +89,8 @@ hsSources context = do -- the build directory regardless of whether they are generated or not. hsObjects :: Context -> Action [FilePath] hsObjects context = do - path <- buildPath context - modules <- pkgDataList (Modules path) - -- GHC.Prim module is only for documentation, we do not actually build it. - mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules) + modules <- interpretInContext context (getConfiguredCabalData ConfCabal.modules) + mapM (objectPath context . moduleSource) modules -- | Generated module files live in the 'Context' specific build directory. generatedFile :: Context -> String -> Action FilePath @@ -105,8 +104,8 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" -- | Module files for a given 'Context'. contextFiles :: Context -> Action [(String, Maybe FilePath)] contextFiles context@Context {..} = do - path <- buildPath context - modules <- fmap sort . pkgDataList $ Modules path + modules <- fmap sort . interpretInContext context $ + getConfiguredCabalData ConfCabal.modules zip modules <$> askOracle (ModuleFiles (stage, package)) -- | This is an important oracle whose role is to find and cache module source @@ -124,9 +123,8 @@ moduleFilesOracle :: Rules () moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package - path <- buildPath context - srcDirs <- pkgDataList $ SrcDirs path - modules <- fmap sort . pkgDataList $ Modules path + srcDirs <- interpretInContext context (getConfiguredCabalData ConfCabal.srcDirs) + modules <- fmap sort $ interpretInContext context (getConfiguredCabalData ConfCabal.modules) autogen <- autogenPath context let dirs = autogen : map (pkgPath package -/-) srcDirs modDirFiles = groupSort $ map decodeModule modules @@ -134,7 +132,7 @@ moduleFilesOracle = void $ do todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles forM todo $ \(mDir, mFiles) -> do let fullDir = unifyPath $ dir -/- mDir - files <- getDirectoryFiles fullDir moduleFilePatterns + files <- getDirectoryFiles fullDir (moduleFilePatterns stage) let cmp f = compare (dropExtension f) found = intersectOrd cmp files mFiles return (map (fullDir -/-) found, mDir) diff --git a/src/Oracles/PackageData.hs b/src/Oracles/PackageData.hs deleted file mode 100644 index cdfe9bfb48..0000000000 --- a/src/Oracles/PackageData.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Oracles.PackageData ( - PackageData (..), PackageDataList (..), pkgData, pkgDataList - ) where - -import Hadrian.Oracles.TextFile - -import Base - -newtype PackageData = BuildGhciLib FilePath - -data PackageDataList = AsmSrcs FilePath - | CcArgs FilePath - | CSrcs FilePath - | CmmSrcs FilePath - | CppArgs FilePath - | DepCcArgs FilePath - | DepExtraLibs FilePath - | DepIds FilePath - | DepIncludeDirs FilePath - | DepLdArgs FilePath - | DepLibDirs FilePath - | DepNames FilePath - | Deps FilePath - | HiddenModules FilePath - | HsArgs FilePath - | IncludeDirs FilePath - | LdArgs FilePath - | Modules FilePath - | SrcDirs FilePath - -askPackageData :: FilePath -> String -> Action String -askPackageData path = lookupValueOrEmpty (path -/- "package-data.mk") - --- | For each @PackageData path@ the file 'path/package-data.mk' contains a line --- of the form 'path_VERSION = 1.2.3.4'. @pkgData (PackageData path)@ is an --- Action that consults the file and returns "1.2.3.4". -pkgData :: PackageData -> Action String -pkgData packageData = case packageData of - BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB" - --- | @PackageDataList path@ is used for multiple string options separated by --- spaces, such as @path_MODULES = Data.Array Data.Array.Base ...@. --- @pkgListData Modules@ therefore returns ["Data.Array", "Data.Array.Base", ...] -pkgDataList :: PackageDataList -> Action [String] -pkgDataList packageData = fmap (map unquote . words) $ case packageData of - AsmSrcs path -> askPackageData path "S_SRCS" - CcArgs path -> askPackageData path "CC_OPTS" - CSrcs path -> askPackageData path "C_SRCS" - CmmSrcs path -> askPackageData path "CMM_SRCS" - CppArgs path -> askPackageData path "CPP_OPTS" - DepCcArgs path -> askPackageData path "DEP_CC_OPTS" - DepExtraLibs path -> askPackageData path "DEP_EXTRA_LIBS" - DepIds path -> askPackageData path "DEP_IPIDS" - DepIncludeDirs path -> askPackageData path "DEP_INCLUDE_DIRS_SINGLE_QUOTED" - DepLibDirs path -> askPackageData path "DEP_LIB_DIRS_SINGLE_QUOTED" - DepLdArgs path -> askPackageData path "DEP_LD_OPTS" - DepNames path -> askPackageData path "DEP_NAMES" - Deps path -> askPackageData path "DEPS" - HiddenModules path -> askPackageData path "HIDDEN_MODULES" - HsArgs path -> askPackageData path "HC_OPTS" - IncludeDirs path -> askPackageData path "INCLUDE_DIRS" - LdArgs path -> askPackageData path "LD_OPTS" - Modules path -> askPackageData path "MODULES" - SrcDirs path -> askPackageData path "HS_SRC_DIRS" - where - unquote = dropWhile (== '\'') . dropWhileEnd (== '\'') diff --git a/src/Oracles/Setting.hs b/src/Oracles/Setting.hs index aa49011e1e..cc57730f12 100644 --- a/src/Oracles/Setting.hs +++ b/src/Oracles/Setting.hs @@ -72,7 +72,7 @@ data SettingList = ConfCcArgs Stage | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage - | HsCppArgs + | ConfHsCppArgs -- | Maps 'Setting's to names in @cfg/system.config.in@. setting :: Setting -> Action String @@ -130,7 +130,7 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of ConfCppArgs stage -> "conf-cpp-args-" ++ stageString stage ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage - HsCppArgs -> "hs-cpp-args" + ConfHsCppArgs -> "conf-hs-cpp-args" -- | Get a configuration setting. getSetting :: Setting -> Expr c b String diff --git a/src/Rules.hs b/src/Rules.hs index d5c26e8e94..970d2a5faa 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -6,6 +6,7 @@ import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile import Expression +import GHC import qualified Oracles.ModuleFiles import qualified Rules.Compile import qualified Rules.PackageData @@ -20,33 +21,92 @@ import qualified Rules.Program import qualified Rules.Register import Settings import Target -import UserSettings import Utilities allStages :: [Stage] -allStages = [minBound ..] +allStages = [minBound .. maxBound] -- | This rule calls 'need' on all top-level build targets, respecting the -- 'Stage1Only' flag. topLevelTargets :: Rules () -topLevelTargets = action $ do - let libraryPackages = filter isLibrary (knownPackages \\ [libffi]) - need =<< if stage1Only - then do - libs <- concatForM [Stage0, Stage1] $ \stage -> - concatForM libraryPackages $ packageTargets False stage - prgs <- concatForM programsStage1Only $ packageTargets False Stage0 - return $ libs ++ prgs ++ inplaceLibCopyTargets - else do - targets <- concatForM allStages $ \stage -> - concatForM (knownPackages \\ [libffi]) $ - packageTargets False stage - return $ targets ++ inplaceLibCopyTargets +topLevelTargets = do +{- phony "binary-dist" $ do + -- This is kind of incorrect. We should not "need" a phony rule. + -- Instead we should *need* the libraries and binaries we want to + -- put into the binary distribution. For now we will just *need* + -- stage2 and package up bin and lib. + need ["stage2", "docs"] + version <- setting ProjectVersion + cwd <- liftIO getCurrentDirectory + binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" + baseDir <- buildRoot <&> (-/- stageString Stage1) + targetPlatform <- setting TargetPlatformFull + + -- prepare binary distribution configure script + copyFile (cwd -/- "aclocal.m4") (cwd -/- "distrib" -/- "aclocal.m4") + buildWithCmdOptions [Cwd $ cwd -/- "distrib"] $ + target (vanillaContext Stage1 ghc) (Autoreconf $ cwd -/- "distrib") [] [] + + let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform + bindistFilesDir = baseDir -/- ghcVersionPretty + createDirectory bindistFilesDir + + -- copy config.sub, config.guess, install-sh, Makefile files, etc + -- from the source of the tree to the bindist dir + copyFile (cwd -/- "distrib" -/- "configure") (bindistFilesDir -/- "configure") + copyFile (cwd -/- "distrib" -/- "Makefile") (bindistFilesDir -/- "Makefile") + copyFile (cwd -/- "install-sh") (bindistFilesDir -/- "install-sh") + copyFile (cwd -/- "config.sub") (bindistFilesDir -/- "config.sub") + copyFile (cwd -/- "config.guess") (bindistFilesDir -/- "config.guess") + copyFile (cwd -/- "settings.in") (bindistFilesDir -/- "settings.in") + copyFile (cwd -/- "mk" -/- "config.mk.in") (bindistFilesDir -/- "mk" -/- "config.mk.in") + copyFile (cwd -/- "mk" -/- "install.mk.in") (bindistFilesDir -/- "mk" -/- "install.mk.in") + copyDirectory (baseDir -/- "bin") bindistFilesDir + copyDirectory (baseDir -/- "lib") bindistFilesDir + copyDirectory (takeDirectory baseDir -/- "docs") bindistFilesDir + + -- TODO: move stage1/bin, stage1/lib and all the files above to some + -- other (temporary?) directory, and invoke tar there + -- TODO: test with another flavour than quick-with-ng + + buildWithCmdOptions [Cwd baseDir] $ + -- ghc is a fake package here. + target (vanillaContext Stage1 ghc) (Tar Create) + [ ghcVersionPretty ] + {- [ "bin", "lib", "docs", "configure", "config.sub", "config.guess" + , "install-sh", "settings.in", "mk/config.mk.in", "mk/install.mk.in" + , "Makefile" + ] -} + [binDistDir -/- ghcVersionPretty ++ ".tar.xz"] +-} + + phony "stage2" $ do + putNormal "Building stage2" + (programs, libraries) <- partition isProgram <$> stagePackages Stage1 + pgmNames <- mapM (g Stage1) programs + libNames <- mapM (g Stage1) libraries + putNormal . unlines $ + ["| Building Programs: " ++ intercalate ", " pgmNames + ,"| Building Libraries: " ++ intercalate ", " libNames] + + targets <- mapM (f Stage1) =<< stagePackages Stage1 + need targets + where + -- either the package databae 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")) -- TODO: Get rid of the @includeGhciLib@ hack. -- | Return the list of targets associated with a given 'Stage' and 'Package'. -- By setting the Boolean parameter to False it is possible to exclude the GHCi --- library from the targets, and avoid running @ghc-cabal@ to determine wether +-- library from the targets, and avoid running @ghc-cabal@ to determine whether -- GHCi library needs to be built for this package. We typically want to set -- this parameter to True, however it is important to set it to False when -- computing 'topLevelTargets', as otherwise the whole build gets sequentialised @@ -90,16 +150,21 @@ packageRules = do let dynamicContexts = liftM3 Context [Stage1 ..] knownPackages [dynamic] forM_ dynamicContexts Rules.Library.buildDynamicLib - forM_ (filter isProgram knownPackages) $ - Rules.Program.buildProgram readPackageDb + Rules.Program.buildProgram readPackageDb + + forM_ [Stage0 .. ] $ \stage -> do + -- we create a dummy context, that has the correct state, but contains + -- @base@ 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 + -- being forced. + Rules.Register.registerPackages writePackageDb (Context stage base vanilla) forM_ vanillaContexts $ mconcat [ Rules.PackageData.buildPackageData , Rules.Dependencies.buildPackageDependencies readPackageDb , Rules.Documentation.buildPackageDocumentation , Rules.Library.buildPackageGhciLibrary - , Rules.Generate.generatePackageCode - , Rules.Register.registerPackage writePackageDb ] + , Rules.Generate.generatePackageCode ] buildRules :: Rules () buildRules = do @@ -118,6 +183,6 @@ oracleRules = do Hadrian.Oracles.TextFile.textFileOracle Oracles.ModuleFiles.moduleFilesOracle -programsStage1Only :: [Package] -programsStage1Only = [ deriveConstants, genapply, genprimopcode, ghc, ghcCabal - , ghcPkg, hp2ps, hpc, hsc2hs, runGhc ] +-- programsStage1Only :: [Package] +-- programsStage1Only = [ deriveConstants, genapply, genprimopcode, ghc, ghcCabal +-- , ghcPkg, hp2ps, hpc, hsc2hs, runGhc ] diff --git a/src/Rules/Clean.hs b/src/Rules/Clean.hs index 7592c60cfd..1633ecde41 100644 --- a/src/Rules/Clean.hs +++ b/src/Rules/Clean.hs @@ -1,22 +1,19 @@ -module Rules.Clean (clean, cleanSourceTree, cleanRules) where +module Rules.Clean (clean, cleanRules) where import Base clean :: Action () clean = do + putBuild "| Removing Hadrian files..." cleanSourceTree - putBuild "| Remove Hadrian files..." path <- buildRoot - removeDirectory $ path -/- generatedDir - removeFilesAfter path ["//*"] + removeDirectory path putSuccess "| Done. " cleanSourceTree :: Action () cleanSourceTree = do path <- buildRoot forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString - removeDirectory inplaceBinPath - removeDirectory inplaceLibPath removeDirectory "sdistprep" cleanFsUtils @@ -31,6 +28,5 @@ cleanFsUtils = do ] liftIO $ forM_ dirs (flip removeFiles ["fs.*"]) - cleanRules :: Rules () cleanRules = "clean" ~> clean diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs index 8bca888788..4e85db2df6 100644 --- a/src/Rules/Compile.hs +++ b/src/Rules/Compile.hs @@ -11,7 +11,8 @@ import Utilities compilePackage :: [(Resource, Int)] -> Context -> Rules () compilePackage rs context@Context {..} = do - let dir = "//" ++ contextDir context + root <- buildRootRules + let dir = root -/- buildDir context nonHs extension = dir -/- extension "*" <.> osuf way compile compiler obj2src obj = do src <- obj2src context obj @@ -19,9 +20,10 @@ compilePackage rs context@Context {..} = do needDependencies context src $ obj <.> "d" buildWithResources rs $ target context (compiler stage) [src] [obj] compileHs = \[obj, _hi] -> do - path <- buildPath context + path <- contextPath context (src, deps) <- lookupDependencies (path -/- ".dependencies") obj need $ src : deps + needLibrary =<< contextDependencies context buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj] priority 2.0 $ do diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs index f9d17e93d8..d8e66f7c4f 100644 --- a/src/Rules/Dependencies.hs +++ b/src/Rules/Dependencies.hs @@ -12,18 +12,21 @@ import Target import Utilities buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules () -buildPackageDependencies rs context@Context {..} = - "//" ++ contextDir context -/- ".dependencies" %> \deps -> do +buildPackageDependencies rs context@Context {..} = do + root <- buildRootRules + root -/- contextDir context -/- ".dependencies.mk" %> \mk -> do srcs <- hsSources context need srcs orderOnly =<< interpretInContext context generatedDependencies - let mk = deps <.> "mk" if null srcs - then writeFile' mk "" + then writeFileChanged mk "" else buildWithResources rs $ target context (Ghc FindHsDependencies stage) srcs [mk] removeFile $ mk <.> "bak" - mkDeps <- liftIO $ readFile mk + + root -/- contextDir context -/- ".dependencies" %> \deps -> do + need [deps <.> "mk"] + mkDeps <- readFile' (deps <.> "mk") writeFileChanged deps . unlines . map (\(src, deps) -> unwords $ src : deps) . map (bimap unifyPath (map unifyPath)) diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index b8570a3c2e..53421d657a 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -8,14 +8,16 @@ module Rules.Documentation ( import Base import Context +import Expression (getConfiguredCabalData, interpretInContext) import Flavour import GHC import Oracles.ModuleFiles -import Oracles.PackageData import Settings import Target import Utilities +import qualified Hadrian.Haskell.Cabal.Configured as ConfCabal + -- | Build all documentation documentationRules :: Rules () documentationRules = do @@ -82,7 +84,8 @@ buildHtmlDocumentation :: Rules () buildHtmlDocumentation = do mapM_ buildSphinxHtml $ docPaths \\ [ "libraries" ] buildLibraryDocumentation - "//" ++ htmlRoot -/- "index.html" %> \file -> do + root <- buildRootRules + root -/- htmlRoot -/- "index.html" %> \file -> do root <- buildRoot need $ map ((root -/-) . pathIndex) docPaths copyFileUntracked "docs/index.html" file @@ -93,7 +96,8 @@ buildHtmlDocumentation = do -- | Compile a Sphinx ReStructured Text package to HTML buildSphinxHtml :: FilePath -> Rules () buildSphinxHtml path = do - "//" ++ htmlRoot -/- path -/- "index.html" %> \file -> do + root <- buildRootRules + root -/- htmlRoot -/- path -/- "index.html" %> \file -> do let dest = takeDirectory file context = vanillaContext Stage0 docPackage build $ target context (Sphinx Html) [pathPath path] [dest] @@ -104,11 +108,14 @@ buildSphinxHtml path = do -- | Build the haddocks for GHC's libraries buildLibraryDocumentation :: Rules () buildLibraryDocumentation = do - "//" ++ htmlRoot -/- "libraries/index.html" %> \file -> do + root <- buildRootRules + root -/- htmlRoot -/- "libraries/index.html" %> \file -> do haddocks <- allHaddocks - need haddocks - let libDocs = filter (\x -> takeFileName x /= "ghc.haddock") haddocks + let libDocs = filter + (\x -> takeFileName x `notElem` ["ghc.haddock", "rts.haddock"]) + haddocks context = vanillaContext Stage2 docPackage + need libDocs build $ target context (Haddock BuildIndex) libDocs [file] allHaddocks :: Action [FilePath] @@ -117,11 +124,13 @@ allHaddocks = do sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ] +haddockHtmlLib :: FilePath -> FilePath +haddockHtmlLib root = root -/- "lib/html/haddock-bundle.min.js" + -- | Find the haddock files for the dependencies of the current library haddockDependencies :: Context -> Action [FilePath] haddockDependencies context = do - path <- buildPath context - depNames <- pkgDataList $ DepNames path + depNames <- interpretInContext context (getConfiguredCabalData ConfCabal.depNames) sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] @@ -129,26 +138,37 @@ haddockDependencies context = do -- All of them go into the 'doc' subdirectory. Pedantically tracking all built -- files in the Shake database seems fragile and unnecessary. buildPackageDocumentation :: Context -> Rules () -buildPackageDocumentation context@Context {..} = when (stage == Stage1) $ do +buildPackageDocumentation context@Context {..} = when (stage == Stage1 && package /= rts) $ do + root <- buildRootRules -- Js and Css files for haddock output - when (package == haddock) $ haddockHtmlResourcesStamp %> \_ -> do - let dir = takeDirectory haddockHtmlResourcesStamp + when (package == haddock) $ haddockHtmlLib root %> \_ -> do + let dir = takeDirectory (haddockHtmlLib root) liftIO $ removeFiles dir ["//*"] copyDirectory "utils/haddock/haddock-api/resources/html" dir -- Per-package haddocks - "//" ++ pkgName package <.> "haddock" %> \file -> do - haddocks <- haddockDependencies context - srcs <- hsSources context - need $ srcs ++ haddocks - - -- Build Haddock documentation - -- TODO: pass the correct way from Rules via Context - dynamicPrograms <- dynamicGhcPrograms <$> flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla - build $ target (context {way = haddockWay}) (Haddock BuildPackage) - srcs [file] + root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" %> \file -> do + -- this is how ghc-cabal produces "haddock-prologue.txt" files + (syn, desc) <- interpretInContext context . getConfiguredCabalData $ \p -> + (ConfCabal.synopsis p, ConfCabal.description p) + let prologue = if null desc + then syn + else desc + liftIO (writeFile file prologue) + + root -/- htmlRoot -/- "libraries" -/- pkgName package -/- pkgName package <.> "haddock" %> \file -> do + need [ root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" ] + haddocks <- haddockDependencies context + srcs <- hsSources context + need $ srcs ++ haddocks ++ [haddockHtmlLib root] + + -- Build Haddock documentation + -- TODO: pass the correct way from Rules via Context + dynamicPrograms <- dynamicGhcPrograms <$> flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + build $ target (context {way = haddockWay}) (Haddock BuildPackage) + srcs [file] ---------------------------------------------------------------------- -- PDF @@ -160,7 +180,8 @@ buildPdfDocumentation = mapM_ buildSphinxPdf docPaths -- | Compile a Sphinx ReStructured Text package to LaTeX buildSphinxPdf :: FilePath -> Rules () buildSphinxPdf path = do - "//" ++ path <.> "pdf" %> \file -> do + root <- buildRootRules + root -/- pdfRoot -/- path <.> "pdf" %> \file -> do let context = vanillaContext Stage0 docPackage withTempDir $ \dir -> do build $ target context (Sphinx Latex) [pathPath path] [dir] @@ -176,7 +197,8 @@ buildDocumentationArchives = mapM_ buildArchive docPaths buildArchive :: FilePath -> Rules () buildArchive path = do - "//" ++ pathArchive path %> \file -> do + root <- buildRootRules + root -/- pathArchive path %> \file -> do root <- buildRoot let context = vanillaContext Stage0 docPackage src = root -/- pathIndex path diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index a8f3956849..c582e2ea94 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -6,14 +6,15 @@ module Rules.Generate ( import Base import Expression import Flavour +import GHC.Packages import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting import Rules.Gmp import Rules.Libffi -import Target import Settings import Settings.Packages.Rts +import Target import Utilities -- | Track this file to rebuild generated files whenever it changes. @@ -24,10 +25,10 @@ primopsSource :: FilePath primopsSource = "compiler/prelude/primops.txt.pp" primopsTxt :: Stage -> FilePath -primopsTxt stage = contextDir (vanillaContext stage compiler) -/- "primops.txt" +primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" platformH :: Stage -> FilePath -platformH stage = contextDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" +platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -99,59 +100,74 @@ generate file context expr = do putSuccess $ "| Successfully generated " ++ file ++ "." generatePackageCode :: Context -> Rules () -generatePackageCode context@(Context stage pkg _) = - let dir = contextDir context - generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f) +generatePackageCode context@(Context stage pkg _) = do + root <- buildRootRules + let dir = buildDir context + generated f = (root -/- dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f) go gen file = generate file context gen - in do - generated ?> \file -> do - let unpack = fromMaybe . error $ "No generator for " ++ file ++ "." - (src, builder) <- unpack <$> findGenerator context file - need [src] - build $ target context builder [src] [file] - let boot = src -<.> "hs-boot" - whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot" - - priority 2.0 $ do - when (pkg == compiler) $ "//" -/- dir -/- "Config.hs" %> go generateConfigHs - when (pkg == ghcPkg) $ "//" -/- dir -/- "Version.hs" %> go generateVersionHs - - -- TODO: needing platformH is ugly and fragile - when (pkg == compiler) $ do - "//" ++ primopsTxt stage %> \file -> do - root <- buildRoot - need $ [root -/- platformH stage, primopsSource] - ++ fmap (root -/-) includesDependencies - build $ target context HsCpp [primopsSource] [file] - - "//" ++ platformH stage %> go generateGhcBootPlatformH - - -- TODO: why different folders for generated files? - priority 2.0 $ fmap (("//" ++ dir) -/-) - [ "GHC/Prim.hs" - , "GHC/PrimopWrappers.hs" - , "*.hs-incl" ] |%> \file -> do - root <- buildRoot - need [root -/- primopsTxt stage] - build $ target context GenPrimopCode [root -/- primopsTxt stage] [file] - - when (pkg == rts) $ "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file -> - build $ target context GenApply [] [file] - --- TODO: These rules copy runtime dependencies of some executables, such as GHC --- itself (file @ghc-usage.txt@) or Hsc2Hs (file @template-hsc.h@). Ideally, --- these rules should be moved to package-specific settings, so that they can be --- discovered more easily. We also need to add proper support for runtime --- dependencies on directories, which is the case for Haddock -- for the current --- workaround see "Rules.Documentation.haddockHtmlResourcesStamp". + generated ?> \file -> do + let unpack = fromMaybe . error $ "No generator for " ++ file ++ "." + (src, builder) <- unpack <$> findGenerator context file + need [src] + build $ target context builder [src] [file] + let boot = src -<.> "hs-boot" + whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot" + + priority 2.0 $ do + when (pkg == compiler) $ do root dir -/- "Config.hs" %> go generateConfigHs + root dir -/- "*.hs-incl" %> genPrimopCode context + when (pkg == ghcPrim) $ do (root dir -/- "GHC/Prim.hs") %> genPrimopCode context + (root dir -/- "GHC/PrimopWrappers.hs") %> genPrimopCode context + when (pkg == ghcPkg) $ do root dir -/- "Version.hs" %> go generateVersionHs + + -- TODO: needing platformH is ugly and fragile + when (pkg == compiler) $ do + root -/- primopsTxt stage %> \file -> do + root <- buildRoot + need $ [ root -/- platformH stage + , primopsSource] + ++ fmap (root -/-) includesDependencies + build $ target context HsCpp [primopsSource] [file] + + -- only generate this once! Until we have the include logic fixed. + -- See the note on `platformH` + when (stage == Stage0) $ do + root "compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH + root platformH stage %> go generateGhcBootPlatformH + + when (pkg == rts) $ do + root dir -/- "cmm/AutoApply.cmm" %> \file -> + build $ target context GenApply [] [file] + + -- XXX: this should be fixed properly, e.g. generated here on demand. + (root dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir)) + (root dir -/- "ghcautoconf.h") <~ (buildRoot <&> (-/- generatedDir)) + (root dir -/- "ghcplatform.h") <~ (buildRoot <&> (-/- generatedDir)) + (root dir -/- "ghcversion.h") <~ (buildRoot <&> (-/- generatedDir)) + when (pkg == integerGmp) $ do + (root dir -/- "ghc-gmp.h") <~ (buildRoot <&> (-/- "include")) + where + pattern <~ mdir = pattern %> \file -> do + dir <- mdir + copyFile (dir -/- takeFileName file) file + +genPrimopCode :: Context -> FilePath -> Action () +genPrimopCode context@(Context stage _pkg _) file = do + root <- buildRoot + need [root -/- primopsTxt stage] + build $ target context GenPrimopCode [root -/- primopsTxt stage] [file] + copyRules :: Rules () copyRules = do - (inplaceLibPath -/- "ghc-usage.txt") <~ return "driver" - (inplaceLibPath -/- "ghci-usage.txt" ) <~ return "driver" - (inplaceLibPath -/- "llvm-targets") <~ return "." - (inplaceLibPath -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir)) - (inplaceLibPath -/- "settings") <~ return "." - (inplaceLibPath -/- "template-hsc.h") <~ return (pkgPath hsc2hs) + root <- buildRootRules + forM_ [Stage0 ..] $ \stage -> do + let prefix = root -/- stageString stage -/- "lib" + (prefix -/- "ghc-usage.txt") <~ return "driver" + (prefix -/- "ghci-usage.txt" ) <~ return "driver" + (prefix -/- "llvm-targets") <~ return "." + (prefix -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir)) + (prefix -/- "settings") <~ return "." + (prefix -/- "template-hsc.h") <~ return (pkgPath hsc2hs) where pattern <~ mdir = pattern %> \file -> do dir <- mdir @@ -159,16 +175,17 @@ copyRules = do generateRules :: Rules () generateRules = do - priority 2.0 $ ("//" ++ generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH - priority 2.0 $ ("//" ++ generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH - priority 2.0 $ ("//" ++ generatedDir -/- "ghcversion.h") <~ generateGhcVersionH + root <- buildRootRules + priority 2.0 $ (root -/- generatedDir -/- "ghcautoconf.h") <~ generateGhcAutoconfH + priority 2.0 $ (root -/- generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH + priority 2.0 $ (root -/- generatedDir -/- "ghcversion.h") <~ generateGhcVersionH ghcSplitPath %> \_ -> do generate ghcSplitPath emptyTarget generateGhcSplit makeExecutable ghcSplitPath -- TODO: simplify, get rid of fake rts context - "//" ++ generatedDir ++ "//*" %> \file -> do + root -/- generatedDir ++ "//*" %> \file -> do withTempDir $ \dir -> build $ target rtsContext DeriveConstants [] [file, dir] where @@ -350,7 +367,7 @@ generateConfigHs = do , "cLibFFI :: Bool" , "cLibFFI = " ++ show cLibFFI , "cGhcThreaded :: Bool" - , "cGhcThreaded = " ++ show (threaded `elem` rtsWays) + , "cGhcThreaded = " ++ show (any (wayUnit Threaded) rtsWays) , "cGhcDebugged :: Bool" , "cGhcDebugged = " ++ show debugged , "cGhcRtsWithLibdw :: Bool" diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index 46fad8a32c..89a88e454d 100644 --- a/src/Rules/Gmp.hs +++ b/src/Rules/Gmp.hs @@ -1,5 +1,5 @@ module Rules.Gmp ( - gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH, gmpBuildInfoPath + gmpRules, gmpBuildPath, gmpObjectsDir, gmpLibraryH ) where import Base @@ -24,7 +24,7 @@ gmpContext = vanillaContext Stage1 integerGmp -- | Build directory for in-tree GMP library. gmpBuildPath :: Action FilePath -gmpBuildPath = buildRoot <&> (-/- stageString (stage gmpContext) -/- "gmp") +gmpBuildPath = buildRoot <&> (-/- buildDir gmpContext -/- "gmp") -- | GMP library header, relative to 'gmpBuildPath'. gmpLibraryH :: FilePath @@ -34,10 +34,6 @@ gmpLibraryH = "include/ghc-gmp.h" gmpObjectsDir :: FilePath gmpObjectsDir = "objs" --- | Path to the GMP library buildinfo file. -gmpBuildInfoPath :: FilePath -gmpBuildInfoPath = pkgPath integerGmp -/- "integer-gmp.buildinfo" - configureEnvironment :: Action [CmdOption] configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1 , builderEnvironment "AR" (Ar Unpack Stage1) @@ -46,9 +42,10 @@ configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1 gmpRules :: Rules () gmpRules = do -- Copy appropriate GMP header and object files - "//" ++ gmpLibraryH %> \header -> do + root <- buildRootRules + root gmpLibraryH %> \header -> do windows <- windowsHost - configMk <- readFile' $ gmpBase -/- "config.mk" + configMk <- readFile' =<< (gmpBuildPath <&> (-/- "config.mk")) if not windows && -- TODO: We don't use system GMP on Windows. Fix? any (`isInfixOf` configMk) [ "HaveFrameworkGMP = YES", "HaveLibGmp = YES" ] then do @@ -66,24 +63,27 @@ gmpRules = do copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH) -- Build in-tree GMP library - "//" ++ gmpLibrary %> \lib -> do + root gmpLibrary %> \lib -> do gmpPath <- gmpBuildPath build $ target gmpContext (Make gmpPath) [gmpPath -/- "Makefile"] [lib] putSuccess "| Successfully built custom library 'gmp'" -- In-tree GMP header is built by the gmpLibraryH rule - "//" ++ gmpLibraryInTreeH %> \_ -> do + root gmpLibraryInTreeH %> \_ -> do gmpPath <- gmpBuildPath need [gmpPath -/- gmpLibraryH] -- This causes integerGmp package to be configured, hence creating the files - [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ -> do - dataFile <- pkgDataFile gmpContext - need [dataFile] + root "gmp/config.mk" %> \_ -> do + -- setup-config, triggers `ghc-cabal configure` + -- everything of a package should depend on that + -- in the first place. + setupConfig <- contextPath gmpContext <&> (-/- "setup-config") + need [setupConfig] -- Run GMP's configure script -- TODO: Get rid of hard-coded @gmp@. - "//gmp/Makefile" %> \mk -> do + root "gmp/Makefile" %> \mk -> do env <- configureEnvironment gmpPath <- gmpBuildPath need [mk <.> "in"] @@ -91,7 +91,7 @@ gmpRules = do target gmpContext (Configure gmpPath) [mk <.> "in"] [mk] -- Extract in-tree GMP sources and apply patches - "//gmp/Makefile.in" %> \_ -> do + root "gmp/Makefile.in" %> \_ -> do gmpPath <- gmpBuildPath removeDirectory gmpPath -- Note: We use a tarball like gmp-4.2.4-nodoc.tar.bz2, which is diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs index 190bc48b7e..fb4fc97013 100644 --- a/src/Rules/Install.hs +++ b/src/Rules/Install.hs @@ -1,5 +1,5 @@ -module Rules.Install (installRules) where - +module Rules.Install () where +{- import Hadrian.Oracles.DirectoryContents import qualified System.Directory as IO @@ -347,3 +347,4 @@ installDocs = do forM_ ["Haddock", "libraries", "users_guide"] $ \dirname -> do let dir = root -/- "docs/html" -/- dirname whenM (doesDirectoryExist dir) $ copyDirectory dir htmlDocDir +-} diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index 73f481d88a..9351eb68d2 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -1,7 +1,7 @@ module Rules.Libffi (libffiRules, libffiBuildPath, libffiDependencies) where +import GHC.Packages import Hadrian.Utilities - import Settings.Builders.Common import Settings.Packages.Rts import Target @@ -37,7 +37,7 @@ configureEnvironment = do ldFlags <- interpretInContext libffiContext ldArgs sequence [ builderEnvironment "CC" $ Cc CompileC Stage1 , builderEnvironment "CXX" $ Cc CompileC Stage1 - , builderEnvironment "LD" Ld + , builderEnvironment "LD" (Ld Stage1) , builderEnvironment "AR" (Ar Unpack Stage1) , builderEnvironment "NM" Nm , builderEnvironment "RANLIB" Ranlib @@ -46,11 +46,12 @@ configureEnvironment = do libffiRules :: Rules () libffiRules = do - fmap ("//rts" -/-) libffiDependencies &%> \_ -> do + root <- buildRootRules + fmap ((root "rts/build") -/-) libffiDependencies &%> \_ -> do libffiPath <- libffiBuildPath need [libffiPath -/- libffiLibrary] - "//" ++ libffiLibrary %> \_ -> do + root libffiLibrary %> \_ -> do useSystemFfi <- flag UseSystemFfi rtsPath <- rtsBuildPath if useSystemFfi @@ -75,7 +76,7 @@ libffiRules = do putSuccess "| Successfully built custom library 'libffi'" - "//libffi/Makefile.in" %> \mkIn -> do + root "libffi/build/Makefile.in" %> \mkIn -> do libffiPath <- libffiBuildPath removeDirectory libffiPath tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" @@ -97,7 +98,7 @@ libffiRules = do fixFile mkIn (fixLibffiMakefile top) -- TODO: Get rid of hard-coded @libffi@. - "//libffi/Makefile" %> \mk -> do + root "libffi/build/Makefile" %> \mk -> do need [mk <.> "in"] libffiPath <- libffiBuildPath forM_ ["config.guess", "config.sub"] $ \file -> diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 7b7a179f2f..901631f50f 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -3,20 +3,46 @@ module Rules.Library ( ) where import Hadrian.Haskell.Cabal -import qualified System.Directory as IO +import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId) import Base import Context import Expression hiding (way, package) import Flavour +import GHC.Packages import Oracles.ModuleFiles -import Oracles.PackageData import Oracles.Setting import Rules.Gmp import Settings import Target import Utilities +import qualified System.Directory as IO + +archive :: Way -> String -> String +archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") + +-- | Building a library consist of building +-- the artifacts, and copying it somewhere +-- with cabal, and finally registering it +-- with the compiler via cabal in the +-- package database. +-- +-- So we'll assume rules to build all the +-- package artifacts, and provide rules for +-- the any of the library artifacts. +library :: Context -> Rules () +library context@Context{..} = do + root <- buildRootRules + pkgId <- case pkgCabalFile package of + Just file -> liftIO $ parseCabalPkgId file + Nothing -> return (pkgName package) + + root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ -> do + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId] + return () + libraryObjects :: Context -> Action [FilePath] libraryObjects context@Context{..} = do hsObjs <- hsObjects context @@ -36,7 +62,11 @@ libraryObjects context@Context{..} = do buildDynamicLib :: Context -> Rules () buildDynamicLib context@Context{..} = do - let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package + root <- buildRootRules + pkgId <- case pkgCabalFile package of + Just file -> liftIO $ parseCabalPkgId file + Nothing -> return (pkgName package) + let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId -- OS X libPrefix ++ "*.dylib" %> buildDynamicLibUnix -- Linux @@ -51,8 +81,13 @@ buildDynamicLib context@Context{..} = do buildPackageLibrary :: Context -> Rules () buildPackageLibrary context@Context {..} = do - let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package - libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do + root <- buildRootRules + pkgId <- case pkgCabalFile package of + Just file -> liftIO (parseCabalPkgId file) + Nothing -> return (pkgName package) + let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId + archive = libPrefix ++ (waySuffix way <.> "a") + archive %%> \a -> do objs <- libraryObjects context asuf <- libsuf way let isLib0 = ("//*-0" ++ asuf) ?== a @@ -60,36 +95,45 @@ buildPackageLibrary context@Context {..} = do if isLib0 then build $ target context (Ar Pack stage) [] [a] -- TODO: Scan for dlls else build $ target context (Ar Pack stage) objs [a] - synopsis <- traverse pkgSynopsis (pkgCabalFile package) + synopsis <- pkgSynopsis context unless isLib0 . putSuccess $ renderLibrary (quote (pkgName package) ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") a synopsis + library context + buildPackageGhciLibrary :: Context -> Rules () buildPackageGhciLibrary context@Context {..} = priority 2 $ do - let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package - libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do + root <- buildRootRules + pkgId <- case pkgCabalFile package of + Just file -> liftIO $ parseCabalPkgId file + Nothing -> return (pkgName package) + + let libPrefix = root -/- buildDir context -/- "HS" ++ pkgId + o = libPrefix ++ "*" ++ (waySuffix way <.> "o") + o %> \obj -> do objs <- allObjects context need objs - build $ target context Ld objs [obj] + build $ target context (Ld stage) objs [obj] allObjects :: Context -> Action [FilePath] allObjects context = (++) <$> nonHsObjects context <*> hsObjects context nonHsObjects :: Context -> Action [FilePath] nonHsObjects context = do - path <- buildPath context cObjs <- cObjects context - cmmSrcs <- pkgDataList (CmmSrcs path) + cmmSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cmmSrcs) cmmObjs <- mapM (objectPath context) cmmSrcs eObjs <- extraObjects context return $ cObjs ++ cmmObjs ++ eObjs cObjects :: Context -> Action [FilePath] cObjects context = do - path <- buildPath context - srcs <- pkgDataList (CSrcs path) - mapM (objectPath context) srcs + srcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) + objs <- mapM (objectPath context) srcs + return $ if way context == threaded + then objs + else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs extraObjects :: Context -> Action [FilePath] extraObjects context diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 32a911702d..3229f8eeba 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -3,115 +3,32 @@ module Rules.PackageData (buildPackageData) where import Base import Context import Expression -import Oracles.Setting -import Rules.Generate +import GHC.Packages import Settings.Packages.Rts import Target import Utilities +import Hadrian.Haskell.Cabal.Parse (configurePackage) + -- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files. buildPackageData :: Context -> Rules () buildPackageData context@Context {..} = do - let dir = "//" ++ contextDir context - cabalFile = unsafePkgCabalFile package -- TODO: improve - configure = pkgPath package -/- "configure" + root <- buildRootRules + let dir = root -/- contextDir context -- TODO: Get rid of hardcoded file paths. - [dir -/- "package-data.mk", dir -/- "setup-config"] &%> \[mk, setupConfig] -> do - -- Make sure all generated dependencies are in place before proceeding. - orderOnly =<< interpretInContext context generatedDependencies - - -- GhcCabal may run the configure script, so we depend on it. - whenM (doesFileExist $ configure <.> "ac") $ need [configure] - - -- Before we configure a package its dependencies need to be registered. - need =<< mapM pkgConfFile =<< contextDependencies context + dir -/- "setup-config" %> \_ -> configurePackage context - need [cabalFile] - build $ target context GhcCabal [cabalFile] [mk, setupConfig] - postProcessPackageData context mk - - -- TODO: Get rid of hardcoded file paths. dir -/- "inplace-pkg-config" %> \conf -> do - path <- buildPath context - dataFile <- pkgDataFile context - need [dataFile] -- ghc-cabal builds inplace package configuration file - if package == rts - then 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 - else - fixFile conf $ unlines . map (replace (path "build") path) . lines - - priority 2.0 $ when (nonCabalContext context) $ dir -/- "package-data.mk" %> - generatePackageData context - -generatePackageData :: Context -> FilePath -> Action () -generatePackageData context@Context {..} file = do - orderOnly =<< interpretInContext context generatedDependencies - asmSrcs <- packageAsmSources package - cSrcs <- packageCSources package - cmmSrcs <- packageCmmSources package - genPath <- buildRoot <&> (-/- generatedDir) - writeFileChanged file . unlines $ - [ "S_SRCS = " ++ unwords asmSrcs ] ++ - [ "C_SRCS = " ++ unwords cSrcs ] ++ - [ "CMM_SRCS = " ++ unwords cmmSrcs ] ++ - [ "DEP_EXTRA_LIBS = m" | package == hp2ps ] ++ - [ "CC_OPTS = -I" ++ genPath | package `elem` [hp2ps, rts]] ++ - [ "MODULES = Main" | package == ghcCabal ] ++ - [ "HS_SRC_DIRS = ." | package == ghcCabal ] - putSuccess $ "| Successfully generated " ++ file - -packageCSources :: Package -> Action [FilePath] -packageCSources pkg - | pkg /= rts = getDirectoryFiles (pkgPath pkg) ["*.c"] - | otherwise = do - windows <- windowsHost - sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) . - map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++ - [ if windows then "win32" else "posix" ] - return sources - -packageAsmSources :: Package -> Action [FilePath] -packageAsmSources pkg - | pkg /= rts = return [] - | otherwise = do - buildAdjustor <- anyTargetArch ["i386", "powerpc", "powerpc64"] - buildStgCRunAsm <- anyTargetArch ["powerpc64le"] - return $ [ "AdjustorAsm.S" | buildAdjustor ] - ++ [ "StgCRunAsm.S" | buildStgCRunAsm ] - -packageCmmSources :: Package -> Action [FilePath] -packageCmmSources pkg - | pkg /= rts = return [] - | otherwise = do + dataFile <- pkgDataFile context + need [dataFile] + when (package == rts) $ do + genPath <- buildRoot <&> (-/- generatedDir) rtsPath <- rtsBuildPath - sources <- getDirectoryFiles (pkgPath pkg) ["*.cmm"] - return $ sources ++ [ rtsPath -/- "cmm/AutoApply.cmm" ] - --- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile: --- 1) Drop lines containing '$'. For example, get rid of --- @libraries/Win32_dist-install_CMM_SRCS := $(addprefix cbits/,$(notdir ...@ --- and replace it with a tracked call to getDirectoryFiles. --- 2) Drop path prefixes to individual settings. --- For example, @libraries/deepseq/dist-install_VERSION = 1.4.0.0@ --- is replaced by @VERSION = 1.4.0.0@. --- Reason: Shake's built-in makefile parser doesn't recognise slashes --- TODO (izgzhen): should fix DEP_LIB_REL_DIRS_SEARCHPATH -postProcessPackageData :: Context -> FilePath -> Action () -postProcessPackageData context@Context {..} file = do - top <- topDirectory - cmmSrcs <- getDirectoryFiles (pkgPath package) ["cbits/*.cmm"] - path <- buildPath context - let len = length (pkgPath package) + length (top -/- path) + 2 - fixFile file $ unlines - . (++ ["CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) ]) - . map (drop len) . filter ('$' `notElem`) . lines + 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 diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index dca177f879..4b65d7c25e 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -1,96 +1,59 @@ module Rules.Program (buildProgram) where import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Base import Context import Expression hiding (stage, way) +import GHC import Oracles.ModuleFiles -import Oracles.PackageData -import Oracles.Setting -import Rules.Wrappers +import Oracles.Flag (crossCompiling) import Settings import Settings.Packages.Rts import Target import Utilities -- | TODO: Drop code duplication -buildProgram :: [(Resource, Int)] -> Package -> Rules () -buildProgram rs package = do - forM_ [Stage0 ..] $ \stage -> do - let context = vanillaContext stage package +buildProgram :: [(Resource, Int)] -> Rules () +buildProgram rs = do + root <- buildRootRules + forM_ [Stage0 ..] $ \stage -> + root -/- stageString stage -/- "bin" -/- "*" %> \bin -> do - -- Rules for programs built in 'buildRoot' - "//" ++ contextDir context -/- programName context <.> exe %> \bin -> - buildBinaryAndWrapper rs bin =<< programContext stage package + -- quite inefficient. But we can't access the programName from + -- Rules, as it's an Action, due to being backed by an Oracle. + activeProgramPackages <- filter isProgram <$> stagePackages stage + nameToCtxList <- forM activeProgramPackages $ \pkg -> do + let ctx = vanillaContext stage pkg + name <- programName ctx + return (name <.> exe, ctx) - -- Rules for the GHC package, which is built 'inplace' - when (package == ghc) $ do - inplaceBinPath -/- programName context <.> exe %> \bin -> - buildBinaryAndWrapper rs bin =<< programContext stage package + case lookup (takeFileName bin) nameToCtxList of + Nothing -> fail "Unknown program" + Just (Context {..}) -> do + -- Rules for programs built in 'buildRoot' - inplaceLibBinPath -/- programName context <.> exe %> \bin -> - buildBinary rs bin =<< programContext stage package + -- Custom dependencies: this should be modeled better in the cabal file somehow. - inplaceLibBinPath -/- programName context <.> "bin" %> \bin -> - buildBinary rs bin =<< programContext stage package + when (package == hsc2hs) $ do + -- hsc2hs needs the template-hsc.h file + tmpl <- templateHscPath stage + need [tmpl] + when (package == ghc) $ do + -- ghc depends on settings, platformConstants, llvm-targets + -- ghc-usage.txt, ghci-usage.txt + need =<< ghcDeps stage - -- Rules for other programs built in inplace directories - when (package /= ghc) $ do - let context0 = vanillaContext Stage0 package -- TODO: get rid of context0 - inplaceBinPath -/- programName context0 <.> exe %> \bin -> do - stage <- installStage package -- TODO: get rid of fromJust - buildBinaryAndWrapper rs bin =<< programContext (fromJust stage) package - - inplaceLibBinPath -/- programName context0 <.> exe %> \bin -> do - stage <- installStage package -- TODO: get rid of fromJust - context <- programContext (fromJust stage) package - if package /= iservBin then - -- We *normally* build only unwrapped binaries in inplace/lib/bin - buildBinary rs bin context - else - -- Build both binary and wrapper in inplace/lib/bin for iservBin - buildBinaryAndWrapperLib rs bin context - - inplaceLibBinPath -/- programName context0 <.> "bin" %> \bin -> do - stage <- installStage package -- TODO: get rid of fromJust - buildBinary rs bin =<< programContext (fromJust stage) package - -buildBinaryAndWrapperLib :: [(Resource, Int)] -> FilePath -> Context -> Action () -buildBinaryAndWrapperLib rs bin context = do - windows <- windowsHost - if windows - then buildBinary rs bin context -- We don't build wrappers on Windows - else case lookup context inplaceWrappers of - Nothing -> buildBinary rs bin context -- No wrapper found - Just wrapper -> do - top <- topDirectory - let libdir = top -/- inplaceLibPath - let wrappedBin = inplaceLibBinPath -/- programName context <.> "bin" - need [wrappedBin] - buildWrapper context wrapper bin (WrappedBinary libdir (takeFileName wrappedBin)) - -buildBinaryAndWrapper :: [(Resource, Int)] -> FilePath -> Context -> Action () -buildBinaryAndWrapper rs bin context = do - windows <- windowsHost - if windows - then buildBinary rs bin context -- We don't build wrappers on Windows - else case lookup context inplaceWrappers of - Nothing -> buildBinary rs bin context -- No wrapper found - Just wrapper -> do - top <- topDirectory - let libPath = top -/- inplaceLibPath - wrappedBin = inplaceLibBinPath -/- takeFileName bin - need [wrappedBin] - buildWrapper context wrapper bin (WrappedBinary libPath (takeFileName bin)) - -buildWrapper :: Context -> Wrapper -> FilePath -> WrappedBinary -> Action () -buildWrapper context@Context {..} wrapper wrapperPath wrapped = do - contents <- interpretInContext context $ wrapper wrapped - writeFileChanged wrapperPath contents - makeExecutable wrapperPath - putSuccess $ "| Successfully created wrapper for " ++ - quote (pkgName package) ++ " (" ++ show stage ++ ")." + cross <- crossCompiling + -- for cross compiler, copy the stage0/bin/ + -- into stage1/bin/ + case (cross, stage) of + (True, s) | s > Stage0 -> do + srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin")) + copyFile (srcDir -/- takeFileName bin) bin + _ -> buildBinary rs bin =<< programContext stage package + -- Rules for the GHC package, which is built 'inplace' buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () buildBinary rs bin context@Context {..} = do @@ -101,13 +64,12 @@ buildBinary rs bin context@Context {..} = do when (stage > Stage0) $ do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ rtsContext { way = w } | w <- ways ] - path <- buildPath context - cSrcs <- pkgDataList (CSrcs path) + cSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs need binDeps buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin] - synopsis <- traverse pkgSynopsis (pkgCabalFile package) + synopsis <- pkgSynopsis context putSuccess $ renderProgram (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 7c0a3e00e8..14b085d5e7 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -1,44 +1,97 @@ -module Rules.Register (registerPackage) where +module Rules.Register (registerPackages) where import Base import Context import GHC +import Settings import Target import Utilities --- TODO: Simplify. +import Distribution.ParseUtils +import qualified Distribution.Compat.ReadP as Parse +import Distribution.Version (Version) + +import Hadrian.Expression +import Hadrian.Haskell.Cabal.Parse as Cabal + +parseCabalName :: String -> Maybe (String, Version) +parseCabalName = readPToMaybe parse + where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion + -- | Build rules for registering packages and initialising package databases -- by running the @ghc-pkg@ utility. -registerPackage :: [(Resource, Int)] -> Context -> Rules () -registerPackage rs context@Context {..} = do - when (stage == Stage0) $ do - -- Packages @ghc-boot@ and @ghc-boot-th@ both match the @ghc-boot*@ - -- pattern, therefore we need to use priorities to match the right rule. - -- TODO: Get rid of this hack. - "//" ++ stage0PackageDbDir -/- pkgName package ++ "*.conf" %%> - buildConf rs context +registerPackages :: [(Resource, Int)] -> Context -> Rules () +registerPackages rs context@Context {..} = do + root <- buildRootRules + root -/- relativePackageDbPath stage %> + buildStamp rs context - when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %> - buildStamp rs context + root -/- relativePackageDbPath stage -/- packageDbStamp %> \stamp -> + writeFileLines stamp [] - when (stage == Stage1) $ do - inplacePackageDbPath -/- pkgName package ++ "*.conf" %%> - buildConf rs context + root -/- relativePackageDbPath stage -/- "*.conf" %> \conf -> do + settings <- libPath context <&> (-/- "settings") + platformConstants <- libPath context <&> (-/- "platformConstants") + need [settings, platformConstants] + let Just pkgName | takeBaseName conf == "rts" = Just "rts" + | otherwise = fst <$> parseCabalName (takeBaseName conf) + let Just pkg = findPackageByName pkgName + bootLibs <- filter isLibrary <$> stagePackages Stage0 + case stage of + Stage0 | pkg `notElem` bootLibs -> copyConf rs (context { package = pkg }) conf + _ -> buildConf rs (context { package = pkg }) conf - when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %> - buildStamp rs context buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () -buildConf rs context@Context {..} conf = do - confIn <- pkgInplaceConfig context - need [confIn] - buildWithResources rs $ target context (GhcPkg Update stage) [confIn] [conf] +buildConf _ context@Context {..} _conf = do + depPkgIds <- cabalDependencies context + + -- setup-config, triggers `ghc-cabal configure` + -- everything of a package should depend on that + -- in the first place. + setupConfig <- (contextPath context) <&> (-/- "setup-config") + need [setupConfig] + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds + + ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) + need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] + + -- might need some package-db resource to limit read/write, + -- see packageRules + bldPath <- buildPath context + + -- special package cases (these should ideally be rolled into cabal one way or the other) + when (package == rts) $ + -- iif cabal new about "generated-headers", we could read them from the configuredCabal + -- information, and just "need" them here. + need [ bldPath -/- "DerivedConstants.h" + , bldPath -/- "ghcautoconf.h" + , bldPath -/- "ghcplatform.h" + , bldPath -/- "ghcversion.h" + , bldPath -/- "ffi.h" + ] + + when (package == integerGmp) $ + need [bldPath -/- "ghc-gmp.h"] + + -- copy and register the package + copyPackage context + registerPackage context + +copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action () +copyConf rs context@Context {..} conf = do + depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $ + target context (GhcPkg Dependencies stage) [pkgName package] [] + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds + buildWithResources rs $ + target context (GhcPkg Clone stage) [pkgName package] [conf] + + where + stdOutToPkgIds :: String -> [String] + stdOutToPkgIds = drop 1 . concatMap words . lines buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action () -buildStamp rs Context {..} stamp = do - let path = takeDirectory stamp - removeDirectory path +buildStamp rs Context {..} path = do buildWithResources rs $ target (vanillaContext stage ghc) (GhcPkg Init stage) [] [path] - writeFileLines stamp [] putSuccess $ "| Successfully initialised " ++ path diff --git a/src/Rules/SourceDist.hs b/src/Rules/SourceDist.hs index 3143c4b153..a28da83209 100644 --- a/src/Rules/SourceDist.hs +++ b/src/Rules/SourceDist.hs @@ -12,7 +12,7 @@ sourceDistRules = do "sdist-ghc" ~> do -- We clean the source tree first. -- See https://github.com/snowleopard/hadrian/issues/384. - cleanSourceTree + -- cleanSourceTree version <- setting ProjectVersion need ["sdistprep/ghc-" ++ version ++ "-src.tar.xz"] putSuccess "| Done" diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 1205051313..6964639dd4 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -2,6 +2,7 @@ module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where import Base import Expression +import GHC.Packages import Oracles.Flag import Oracles.Setting import Target @@ -37,7 +38,7 @@ testRules = do needBuilder $ GhcPkg Update Stage1 needBuilder Hp2Ps needBuilder Hpc - needBuilder Hsc2Hs + needBuilder (Hsc2Hs Stage1) build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] [] "test" ~> do diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs index 20763a778e..917f824bd6 100644 --- a/src/Rules/Wrappers.hs +++ b/src/Rules/Wrappers.hs @@ -6,6 +6,8 @@ import Hadrian.Oracles.Path import Base import Expression +import GHC (installStage) +import GHC.Packages import Oracles.Setting import Settings @@ -49,15 +51,16 @@ installRunGhcWrapper WrappedBinary{..} = do inplaceGhcPkgWrapper :: WrappedBinary -> Expr String inplaceGhcPkgWrapper WrappedBinary{..} = do expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - top <- expr topDirectory + stage <- succ <$> getStage -- The wrapper is generated in StageN, but used in StageN+1. Therefore, we -- always use the inplace package database, located at 'inplacePackageDbPath', -- which is used in Stage1 and later. bash <- expr bashPath + path <- expr buildRoot return $ unlines [ "#!" ++ bash , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ - " --global-package-db " ++ top -/- inplacePackageDbPath ++ " ${1+\"$@\"}" ] + " --global-package-db " ++ path -/- relativePackageDbPath stage ++ " ${1+\"$@\"}" ] installGhcPkgWrapper :: WrappedBinary -> Expr String installGhcPkgWrapper WrappedBinary{..} = do diff --git a/src/Settings.hs b/src/Settings.hs old mode 100644 new mode 100755 index 091efc10ca..48ba4c26d0 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -1,12 +1,15 @@ module Settings ( getArgs, getLibraryWays, getRtsWays, flavour, knownPackages, - findPackageByName, getPkgData, getPkgDataList, isLibrary, stagePackages, + findPackageByName, isLibrary, stagePackages, programContext, getIntegerPackage, getDestDir ) where import CommandLine import Expression import Flavour +import GHC.Packages +import UserSettings + import {-# SOURCE #-} Settings.Default import Settings.Flavours.Development import Settings.Flavours.Performance @@ -14,7 +17,6 @@ import Settings.Flavours.Profiled import Settings.Flavours.Quick import Settings.Flavours.Quickest import Settings.Flavours.QuickCross -import UserSettings getArgs :: Args getArgs = expr flavour >>= args diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index fdd9fc5393..15644b9c10 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -1,17 +1,18 @@ module Settings.Builders.Cc (ccBuilderArgs) where +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Settings.Builders.Common ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay builder Cc ? mconcat - [ getPkgDataList CcArgs + [ getConfiguredCabalData ConfCabal.ccOpts , getStagedSettingList ConfCcArgs - , cIncludeArgs , builder (Cc CompileC) ? mconcat [ arg "-Wall" + , cIncludeArgs , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] , arg "-c", arg =<< getInput , arg "-o", arg =<< getOutput ] @@ -22,5 +23,6 @@ ccBuilderArgs = do , arg "-MM", arg "-MG" , arg "-MF", arg output , arg "-MT", arg $ dropExtension output -<.> "o" + , cIncludeArgs , arg "-x", arg "c" , arg =<< getInput ] ] diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index bfcddebe35..4c43fcb99a 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -2,17 +2,18 @@ module Settings.Builders.Common ( module Base, module Expression, module Oracles.Flag, - module Oracles.PackageData, module Oracles.Setting, module Settings, module UserSettings, - cIncludeArgs, ldArgs, cArgs, cWarnings, bootPackageDatabaseArgs + cIncludeArgs, ldArgs, cArgs, cWarnings, + packageDatabaseArgs, bootPackageDatabaseArgs ) where import Base import Expression +import GHC.Packages +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Oracles.Flag -import Oracles.PackageData import Oracles.Setting import Settings import UserSettings @@ -22,13 +23,24 @@ cIncludeArgs = do pkg <- getPackage root <- getBuildRoot path <- getBuildPath - incDirs <- getPkgDataList IncludeDirs - depDirs <- getPkgDataList DepIncludeDirs + incDirs <- getConfiguredCabalData ConfCabal.includeDirs + depDirs <- getConfiguredCabalData ConfCabal.depIncludeDirs + iconvIncludeDir <- getSetting IconvIncludeDir + gmpIncludeDir <- getSetting GmpIncludeDir + ffiIncludeDir <- getSetting FfiIncludeDir + cross <- expr crossCompiling compilerOrGhc <- package compiler ||^ package ghc mconcat [ not (cross && compilerOrGhc) ? arg "-Iincludes" , arg $ "-I" ++ root -/- generatedDir , arg $ "-I" ++ path + , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] + , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir) + -- add the build path with include dirs in case we generated + -- some files with autoconf, which will end up in the build directory. + , pure [ "-I" ++ path -/- dir | dir <- incDirs ] + -- add the package directory with include dirs, for includes + -- shipped with the package , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ] , pure [ "-I" ++ unifyPath dir | dir <- depDirs ] ] @@ -46,13 +58,19 @@ cWarnings = mconcat , notM (flag GccIsClang) ? notM windowsHost ? arg "-Werror=unused-but-set-variable" , notM (flag GccIsClang) ? arg "-Wno-error=inline" ] +packageDatabaseArgs :: Args +packageDatabaseArgs = do + stage <- getStage + dbPath <- expr (packageDbPath stage) + expr (need [dbPath -/- packageDbStamp]) + top <- expr topDirectory + root <- getBuildRoot + prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=") + arg $ prefix ++ root -/- relativePackageDbPath stage + bootPackageDatabaseArgs :: Args bootPackageDatabaseArgs = do stage <- getStage dbPath <- expr $ packageDbPath stage expr $ need [dbPath -/- packageDbStamp] - stage0 ? do - top <- expr topDirectory - root <- getBuildRoot - prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=") - arg $ prefix ++ top -/- root -/- stage0PackageDbDir + stage0 ? packageDatabaseArgs diff --git a/src/Settings/Builders/DeriveConstants.hs b/src/Settings/Builders/DeriveConstants.hs index 7a6e863e9c..bd7511be23 100644 --- a/src/Settings/Builders/DeriveConstants.hs +++ b/src/Settings/Builders/DeriveConstants.hs @@ -1,5 +1,6 @@ module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where +import Builder import Settings.Builders.Common -- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`? diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 3fba00d4d4..cfb18e3eb4 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -1,12 +1,13 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Hadrian.Haskell.Cabal - import Flavour -import Rules.Gmp +import GHC import Settings.Builders.Common import Settings.Warnings +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal + ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] @@ -24,7 +25,7 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do compileC :: Args compileC = builder (Ghc CompileCWithGhc) ? do way <- getWay - let ccArgs = [ getPkgDataList CcArgs + let ccArgs = [ getConfiguredCabalData ConfCabal.ccOpts , getStagedSettingList ConfCcArgs , cIncludeArgs , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ] @@ -40,25 +41,18 @@ compileC = builder (Ghc CompileCWithGhc) ? do ghcLinkArgs :: Args ghcLinkArgs = builder (Ghc LinkHs) ? do - stage <- getStage way <- getWay pkg <- getPackage - libs <- getPkgDataList DepExtraLibs - libDirs <- getPkgDataList DepLibDirs + libs <- pkg == hp2ps ? pure ["m"] intLib <- getIntegerPackage - gmpLibs <- if stage > Stage0 && intLib == integerGmp - then do -- TODO: get this data more gracefully - let strip = fromMaybe "" . stripPrefix "extra-libraries: " - buildInfo <- expr $ readFileLines gmpBuildInfoPath - return $ concatMap (words . strip) buildInfo - else return [] + gmpLibs <- notStage0 ? intLib == integerGmp ? pure ["gmp"] mconcat [ (Dynamic `wayUnit` way) ? pure [ "-shared", "-dynamic", "-dynload", "deploy" ] , arg "-no-auto-link-packages" , nonHsMainPackage pkg ? arg "-no-hs-main" , not (nonHsMainPackage pkg) ? arg "-rtsopts" , pure [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ] - , pure [ "-optl-L" ++ unifyPath dir | dir <- libDirs ] ] + ] findHsDependencies :: Args findHsDependencies = builder (Ghc FindHsDependencies) ? do @@ -71,27 +65,32 @@ findHsDependencies = builder (Ghc FindHsDependencies) ? do , getInputs ] haddockGhcArgs :: Args -haddockGhcArgs = mconcat [ commonGhcArgs, getPkgDataList HsArgs ] +haddockGhcArgs = mconcat [ commonGhcArgs, getConfiguredCabalData ConfCabal.hcOpts ] -- Used in ghcBuilderArgs, ghcCBuilderArgs, ghcMBuilderArgs and haddockGhcArgs. commonGhcArgs :: Args commonGhcArgs = do - way <- getWay - path <- getBuildPath - pkg <- getPackage - when (pkg == rts) $ do - context <- getContext - conf <- expr $ pkgConfFile context - expr $ need [conf] + way <- getWay + path <- getBuildPath + pkg <- getPackage + ghcVersion <- expr $ ghcVersionH mconcat [ arg "-hisuf", arg $ hisuf way , arg "-osuf" , arg $ osuf way , arg "-hcsuf", arg $ hcsuf way , wayGhcArgs , packageGhcArgs , includeGhcArgs + -- when compiling the rts for stage1 or stage2 + -- we do not have the rts in the package db at + -- the time of builind it. As such we need to + -- explicity supply the path to the ghc-version + -- file, to prevent ghc from trying to open the + -- rts package from the package db, and failing + -- over while doing so. + , (pkg == rts) ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion) , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs - , map ("-optP" ++) <$> getPkgDataList CppArgs + , map ("-optP" ++) <$> getConfiguredCabalData ConfCabal.cppOpts , arg "-odir" , arg path , arg "-hidir" , arg path , arg "-stubdir" , arg path ] @@ -111,13 +110,13 @@ wayGhcArgs = do pure ["-ticky", "-DTICKY_TICKY"] ] packageGhcArgs :: Args -packageGhcArgs = withHsPackage $ \cabalFile -> do - pkgId <- expr $ pkgIdentifier cabalFile +packageGhcArgs = withHsPackage $ \ctx -> do + pkgId <- expr $ pkgIdentifier ctx mconcat [ arg "-hide-all-packages" , arg "-no-user-package-db" - , bootPackageDatabaseArgs + , packageDatabaseArgs , libraryPackage ? arg ("-this-unit-id " ++ pkgId) - , map ("-package-id " ++) <$> getPkgDataList DepIds ] + , map ("-package-id " ++) <$> getConfiguredCabalData ConfCabal.depIpIds ] includeGhcArgs :: Args includeGhcArgs = do @@ -125,7 +124,7 @@ includeGhcArgs = do path <- getBuildPath root <- getBuildRoot context <- getContext - srcDirs <- getPkgDataList SrcDirs + srcDirs <- getConfiguredCabalData ConfCabal.srcDirs autogen <- expr $ autogenPath context mconcat [ arg "-i" , arg $ "-i" ++ path diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 78b45870b9..29b99ed680 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -2,37 +2,73 @@ module Settings.Builders.GhcCabal ( ghcCabalBuilderArgs ) where -import Hadrian.Haskell.Cabal +import Data.Maybe (fromJust) +import Builder ( ArMode ( Pack ) ) import Context import Flavour +import GHC.Packages +import Hadrian.Builder (getBuilderPath, needBuilder ) +import Hadrian.Haskell.Cabal import Settings.Builders.Common ghcCabalBuilderArgs :: Args -ghcCabalBuilderArgs = builder GhcCabal ? do +ghcCabalBuilderArgs = mconcat + [ builder (GhcCabal Conf) ? do verbosity <- expr getVerbosity top <- expr topDirectory - path <- getBuildPath - notStage0 ? expr (need inplaceLibCopyTargets) + path <- getContextPath + stage <- getStage mconcat [ arg "configure" - , arg =<< pkgPath <$> getPackage + -- don't strip libraries when cross compiling. + -- XXX we need to set --with-strip= (stripCmdPath :: Action FilePath), and if it's ':' disable + -- stripping as well. As it is now, I believe we might have issues with stripping on + -- windows, as I can't see a consumre of `stripCmdPath`. + , crossCompiling ? pure [ "--disable-executable-stripping", "--disable-library-stripping" ] + , arg "--cabal-file" + , arg =<< fromJust . pkgCabalFile <$> getPackage + , arg "--distdir" , arg $ top -/- path + , arg "--ipid" + , arg "$pkg-$version" + , arg "--prefix" + , arg "${pkgroot}/.." , withStaged $ Ghc CompileHs , withStaged (GhcPkg Update) + , withBuilderArgs (GhcPkg Update stage) , bootPackageDatabaseArgs , libraryArgs , configureArgs , bootPackageConstraints , withStaged $ Cc CompileC - , notStage0 ? with Ld + , notStage0 ? with (Ld stage) , withStaged (Ar Pack) , with Alex , with Happy - , verbosity < Chatty ? pure [ "-v0", "--configure-option=--quiet" - , "--configure-option=--disable-option-checking" ] ] + , verbosity < Chatty ? + pure [ "-v0", "--configure-option=--quiet" + , "--configure-option=--disable-option-checking" + ] + ] + , builder (GhcCabal Copy) ? do + mconcat [ arg "copy" + , getInputs + ] + , builder (GhcCabal Reg) ? do + top <- expr topDirectory + path <- getContextPath + mconcat [ arg "register" + , arg =<< pkgPath <$> getPackage + , arg $ top -/- path + , stagedBuilderPath (Ghc CompileHs) + , stagedBuilderPath (GhcPkg Update) + , getInputs + ]] + -- TODO: Isn't vanilla always built? If yes, some conditions are redundant. -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci? +-- TODO: should `elem` be `wayUnit`? libraryArgs :: Args libraryArgs = do ways <- getLibraryWays @@ -81,14 +117,16 @@ configureArgs = do , conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir , conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull) - , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage ] + , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage + , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] bootPackageConstraints :: Args bootPackageConstraints = stage0 ? do bootPkgs <- expr $ stagePackages Stage0 let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs + ctx <- getContext constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do - version <- traverse pkgVersion (pkgCabalFile pkg) + version <- pkgVersion (ctx { Context.package = pkg}) return $ fmap ((pkgName pkg ++ " == ") ++) version pure $ concat [ ["--constraint", c] | c <- constraints ] @@ -100,7 +138,7 @@ cppArgs = do withBuilderKey :: Builder -> String withBuilderKey b = case b of Ar _ _ -> "--with-ar=" - Ld -> "--with-ld=" + Ld _ -> "--with-ld=" Cc _ _ -> "--with-gcc=" Ghc _ _ -> "--with-ghc=" Alex -> "--with-alex=" @@ -108,6 +146,16 @@ withBuilderKey b = case b of GhcPkg _ _ -> "--with-ghc-pkg=" _ -> error $ "withBuilderKey: not supported builder " ++ show b +-- Adds arguments to builders if needed. +withBuilderArgs :: Builder -> Args +withBuilderArgs b = case b of + GhcPkg _ stage -> do + top <- expr topDirectory + pkgDb <- expr $ packageDbPath stage + notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb) + _ -> return [] -- no arguments + + -- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex. with :: Builder -> Args with b = do @@ -120,3 +168,12 @@ with b = do withStaged :: (Stage -> Builder) -> Args withStaged sb = with . sb =<< getStage +stagedBuilderPath :: (Stage -> Builder) -> Args +stagedBuilderPath sb = builderPath . sb =<< getStage + where builderPath :: Builder -> Args + builderPath b = do + path <- getBuilderPath b + if (null path) then mempty else do + top <- expr topDirectory + expr $ needBuilder b + arg $ unifyPath (top path) diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs index ba705c6892..4056d849b5 100644 --- a/src/Settings/Builders/GhcPkg.hs +++ b/src/Settings/Builders/GhcPkg.hs @@ -5,12 +5,24 @@ import Settings.Builders.Common ghcPkgBuilderArgs :: Args ghcPkgBuilderArgs = mconcat [ builder (GhcPkg Init) ? mconcat [ arg "init", arg =<< getOutput ] - + , builder (GhcPkg Clone) ? do + verbosity <- expr getVerbosity + stage <- getStage + pkgDb <- expr $ packageDbPath stage + mconcat [ arg "--global-package-db" + , arg pkgDb + , arg "register" + , verbosity < Chatty ? arg "-v0" + ] , builder (GhcPkg Update) ? do verbosity <- expr getVerbosity context <- getContext config <- expr $ pkgInplaceConfig context - mconcat [ arg "update" + stage <- getStage + pkgDb <- expr $ packageDbPath stage + mconcat [ notStage0 ? arg "--global-package-db" + , notStage0 ? arg pkgDb + , arg "update" , arg "--force" , verbosity < Chatty ? arg "-v0" , bootPackageDatabaseArgs diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index ed29012c0a..fa987cd681 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -1,20 +1,18 @@ module Settings.Builders.Haddock (haddockBuilderArgs) where -import Hadrian.Utilities import Hadrian.Haskell.Cabal - +import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Utilities import Rules.Documentation import Settings.Builders.Common import Settings.Builders.Ghc -- | Given a version string such as "2.16.2" produce an integer equivalent. versionToInt :: String -> Int -versionToInt s = case map read . words $ replaceEq '.' ' ' s of - [major, minor, patch] -> major * 1000 + minor * 10 + patch - _ -> error "versionToInt: cannot parse version." +versionToInt = read . dropWhile (=='0') . filter (/='.') haddockBuilderArgs :: Args -haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat +haddockBuilderArgs = withHsPackage $ \ctx -> mconcat [ builder (Haddock BuildIndex) ? do output <- getOutput inputs <- getInputs @@ -32,11 +30,11 @@ haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat output <- getOutput pkg <- getPackage path <- getBuildPath - version <- expr $ pkgVersion cabalFile - synopsis <- expr $ pkgSynopsis cabalFile - deps <- getPkgDataList DepNames + Just version <- expr $ pkgVersion ctx + Just synopsis <- expr $ pkgSynopsis ctx + deps <- getConfiguredCabalData ConfCabal.depNames haddocks <- expr . haddockDependencies =<< getContext - hVersion <- expr $ pkgVersion (unsafePkgCabalFile haddock) -- TODO: improve + Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs mconcat [ arg "--verbosity=0" @@ -52,7 +50,7 @@ haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat , arg $ "--prologue=" ++ path -/- "haddock-prologue.txt" , arg $ "--optghc=-D__HADDOCK_VERSION__=" ++ show (versionToInt hVersion) - , map ("--hide=" ++) <$> getPkgDataList HiddenModules + , map ("--hide=" ++) <$> getConfiguredCabalData ConfCabal.otherModules , pure [ "--read-interface=../" ++ dep ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME}," ++ haddock | (dep, haddock) <- zip deps haddocks ] diff --git a/src/Settings/Builders/HsCpp.hs b/src/Settings/Builders/HsCpp.hs index aeb5255990..78e4aabfb8 100644 --- a/src/Settings/Builders/HsCpp.hs +++ b/src/Settings/Builders/HsCpp.hs @@ -1,5 +1,6 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where +import GHC.Packages import Settings.Builders.Common hsCppBuilderArgs :: Args @@ -7,7 +8,7 @@ hsCppBuilderArgs = builder HsCpp ? do stage <- getStage root <- getBuildRoot ghcPath <- expr $ buildPath (vanillaContext stage compiler) - mconcat [ getSettingList HsCppArgs + mconcat [ getSettingList ConfHsCppArgs , arg "-P" , arg "-Iincludes" , arg $ "-I" ++ root -/- generatedDir diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 80e80db7d0..563011a7a9 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -1,5 +1,9 @@ module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where +import Builder () +import GHC (autogenPath) +import Hadrian.Builder (getBuilderPath) +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Settings.Builders.Common hsc2hsBuilderArgs :: Args @@ -15,9 +19,10 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do version <- if stage == Stage0 then expr ghcCanonVersion else getSetting ProjectVersionInt + tmpl <- (top -/-) <$> expr (templateHscPath Stage0) mconcat [ arg $ "--cc=" ++ ccPath , arg $ "--ld=" ++ ccPath - , notM windowsHost ? arg "--cross-safe" + , notM windowsHost ? notM crossCompiling ? arg "--cross-safe" , pure $ map ("-I" ++) (words gmpDir) , map ("--cflag=" ++) <$> getCFlags , map ("--lflag=" ++) <$> getLFlags @@ -27,7 +32,7 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do , notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1") , notStage0 ? arg ("--cflag=-D" ++ tOs ++ "_HOST_OS=1" ) , arg $ "--cflag=-D__GLASGOW_HASKELL__=" ++ version - , arg $ "--template=" ++ top -/- templateHscPath + , arg $ "--template=" ++ tmpl , arg =<< getInput , arg "-o", arg =<< getOutput ] @@ -38,18 +43,16 @@ getCFlags = do mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) , getStagedSettingList ConfCppArgs , cIncludeArgs - , getPkgDataList CppArgs - , getPkgDataList DepCcArgs + , getConfiguredCabalData ConfCabal.ccOpts + -- XXX: is cppOpts correct here? + , getConfiguredCabalData ConfCabal.cppOpts + , getConfiguredCabalData ConfCabal.depCcOpts , cWarnings , arg "-include", arg $ autogen -/- "cabal_macros.h" ] getLFlags :: Expr [String] -getLFlags = do - libDirs <- getPkgDataList DepLibDirs - extraLibs <- getPkgDataList DepExtraLibs +getLFlags = mconcat [ getStagedSettingList ConfGccLinkerArgs , ldArgs - , getPkgDataList LdArgs - , pure [ "-L" ++ unifyPath dir | dir <- libDirs ] - , pure [ "-l" ++ unifyPath dir | dir <- extraLibs ] - , getPkgDataList DepLdArgs ] + , getConfiguredCabalData ConfCabal.ldOpts + , getConfiguredCabalData ConfCabal.depLdOpts ] diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index c348bf1385..24ee9c962e 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -1,9 +1,10 @@ module Settings.Builders.RunTest (runTestBuilderArgs) where -import Hadrian.Utilities - import CommandLine (TestArgs(..), defaultTestArgs) import Flavour +import GHC.Packages +import Hadrian.Builder (getBuilderPath) +import Hadrian.Utilities import Rules.Test import Settings.Builders.Common diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 5658d000ab..edc4025180 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -4,15 +4,10 @@ module Settings.Default ( defaultFlavour, defaultSplitObjects ) where -import qualified Hadrian.Builder.Ar -import qualified Hadrian.Builder.Sphinx -import qualified Hadrian.Builder.Tar - import CommandLine import Expression import Flavour import Oracles.Flag -import Oracles.PackageData import Settings import Settings.Builders.Alex import Settings.Builders.DeriveConstants @@ -30,21 +25,18 @@ import Settings.Builders.Ld import Settings.Builders.Make import Settings.Builders.RunTest import Settings.Builders.Xelatex -import Settings.Packages.Base -import Settings.Packages.Cabal -import Settings.Packages.Compiler -import Settings.Packages.Ghc -import Settings.Packages.GhcCabal -import Settings.Packages.Ghci -import Settings.Packages.GhcPkg -import Settings.Packages.GhcPrim -import Settings.Packages.Haddock -import Settings.Packages.Haskeline -import Settings.Packages.IntegerGmp +import Settings.Packages import Settings.Packages.Rts -import Settings.Packages.RunGhc import Settings.Warnings +import {-# SOURCE #-} Builder +import GHC +import GHC.Packages +import qualified Hadrian.Builder.Ar +import qualified Hadrian.Builder.Sphinx +import qualified Hadrian.Builder.Tar +import Hadrian.Haskell.Cabal.Configured as ConfCabal + -- TODO: Move C source arguments here -- | Default and package-specific source arguments. data SourceArgs = SourceArgs @@ -57,7 +49,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault - , getPkgDataList HsArgs + , getConfiguredCabalData ConfCabal.hcOpts , libraryPackage ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] @@ -87,7 +79,8 @@ defaultLibraryWays :: Ways defaultLibraryWays = mconcat [ pure [vanilla] , notStage0 ? pure [profiling] - , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] + -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] + ] -- | Default build ways for the RTS. defaultRtsWays :: Ways @@ -96,9 +89,10 @@ defaultRtsWays = do mconcat [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ] , (profiling `elem` ways) ? pure [threadedProfiling] - , (dynamic `elem` ways) ? - pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic - , loggingDynamic, threadedLoggingDynamic ] ] + -- , (dynamic `elem` ways) ? + -- pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic + -- , loggingDynamic, threadedLoggingDynamic ] + ] -- Please update doc/flavours.md when changing the default build flavour. -- | Default build flavour. Other build flavours are defined in modules @@ -159,17 +153,6 @@ defaultBuilderArgs = mconcat -- | All 'Package'-dependent command line arguments. defaultPackageArgs :: Args defaultPackageArgs = mconcat - [ basePackageArgs - , cabalPackageArgs - , compilerPackageArgs - , ghcCabalPackageArgs - , ghciPackageArgs - , ghcPackageArgs - , ghcPkgPackageArgs - , ghcPrimPackageArgs - , haddockPackageArgs - , haskelinePackageArgs - , integerGmpPackageArgs + [ packageArgs , rtsPackageArgs - , runGhcPackageArgs , warningArgs ] diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs new file mode 100644 index 0000000000..91adc61bfb --- /dev/null +++ b/src/Settings/Packages.hs @@ -0,0 +1,125 @@ +module Settings.Packages (packageArgs) where + +import Expression +import Flavour +import GHC.Packages +import Oracles.Setting +import Oracles.Flag +import Rules.Gmp +import Settings + +packageArgs :: Args +packageArgs = do + intLibPkg <- getIntegerPackage + integerLibraryName <- pkgName <$> getIntegerPackage + + stage <- getStage + rtsWays <- getRtsWays + path <- getBuildPath + + compilerBuildPath <- expr $ buildPath (vanillaContext stage compiler) + + gmpBuildPath <- expr gmpBuildPath + let includeGmp = "-I" ++ gmpBuildPath -/- "include" + + version <- getSetting ProjectVersion + + mconcat + [ package base + ? mconcat [ builder CabalFlags ? arg ('+':integerLibraryName) + -- This fixes the 'unknown symbol stat' issue. + -- See: https://github.com/snowleopard/hadrian/issues/259. + , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ] + , package bytestring + ? builder CabalFlags ? intLibPkg == integerSimple ? arg "integer-simple" + , package text + -- text is rather tricky. It's a boot lib, and it tries to determine on + -- it's own if it should link against integer-gmp or integer-simple. + -- For stage0, we need to use the integer library that the bootstrap + -- compiler has. (the interger-lib is not a boot lib) but as such, we'll + -- copy it over into the stage0 package-db (maybe we should stop doing this?) + -- And subsequently text for stage1 will detect the same integer lib again, + -- even though we don't build it in stage1, and at that point the + -- configuration is just wrong. + ? builder CabalFlags ? notStage0 ? intLibPkg == integerSimple ? pure [ "+integer-simple" + , "-bytestring-builder"] + , package cabal + -- Cabal is a rather large library and quite slow to compile. Moreover, we + -- build it for stage0 only so we can link ghc-pkg against it, so there is + -- little reason to spend the effort to optimize it. + ? stage0 ? builder Ghc ? arg "-O0" + , package compiler + ? mconcat [ builder Alex ? arg "--latin1" + , builder (Ghc CompileHs) ? mconcat + [ inputs ["//GHC.hs", "//GhcMake.hs"] ? arg "-fprof-auto" + , input "//Parser.hs" ? + pure ["-O0", "-fno-ignore-interface-pragmas", "-fcmm-sink" ] ] + , builder (GhcCabal Conf) ? mconcat + [ arg $ "--ghc-option=-DSTAGE=" ++ show (fromEnum stage + 1) + , arg "--disable-library-for-ghci" + , anyTargetOs ["openbsd"] ? arg "--ld-options=-E" + , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS" + , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP" + , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP" + , (any (wayUnit Threaded) rtsWays) ? + notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS" + , ghcWithInterpreter ? + ghcEnableTablesNextToCode ? + notM (flag GhcUnregisterised) ? + notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE" + , ghcWithInterpreter ? + ghciWithDebugger <$> flavour ? + notStage0 ? arg "--ghc-option=-DDEBUGGER" + , ghcProfiled <$> flavour ? + notStage0 ? arg "--ghc-pkg-option=--force" ] + , builder CabalFlags ? mconcat + [ ghcWithNativeCodeGen ? arg "ncg" + , ghcWithInterpreter ? + notStage0 ? arg "ghci" + , crossCompiling ? arg "-terminfo" + ] + , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] + , package ghc + ? mconcat [ builder Ghc ? arg ("-I" ++ compilerBuildPath) + , builder CabalFlags ? ghcWithInterpreter ? notStage0 ? arg "ghci" + , builder CabalFlags ? crossCompiling ? arg "-terminfo" ] + , package ghcPkg + ? builder CabalFlags ? crossCompiling ? arg "-terminfo" + , package ghcPrim + ? mconcat [ builder CabalFlags ? arg "include-ghc-prim" + , builder (Cc CompileC) ? + (not <$> flag GccIsClang) ? + input "//cbits/atomic.c" ? arg "-Wno-sync-nand" ] + -- XXX: This should not be *not <$> crossCompiling*, but ensure + -- that the bootstrap compiler has the same version as the + -- one we are building. + -- XXX: In that case we also do not need to build most of the + -- stage1 libraries, as we already know that the compiler + -- comes with the most recent versions. + -- XXX: The use case here is that we want to build ghc-proxy for + -- the cross compiler. That one needs to be compiled by the + -- bootstrap compiler as it needs to run on the host. and as + -- such libiserv needs GHCi.TH, GHCi.Message and GHCi.Run from + -- ghci. And those are beind the -fghci flag. + , package ghci ? notStage0 ? builder CabalFlags ? arg "ghci" + , package ghci ? crossCompiling ? stage0 ? builder CabalFlags ? arg "ghci" + , package haddock ? builder CabalFlags ? arg "in-ghc-tree" + , package haskeline ? builder CabalFlags ? crossCompiling ? arg "-terminfo" + , package hsc2hs ? builder CabalFlags ? arg "in-ghc-tree" + , package integerGmp + ? mconcat [ builder Cc ? arg includeGmp + , builder (GhcCabal Conf) ? mconcat + [ -- (null gmpIncludeDir && null gmpLibDir) ? + -- XXX: this should respect some settings flag "InTreeGmp". + -- depending on include and lib dir, is bound to fail + -- these are only set if ./configure was explicilty + -- called with gmp include and lib dirs. Their absense + -- as such does not imply in-tree-gmp + -- arg "--configure-option=--with-intree-gmp" + arg ("--configure-option=CFLAGS=" ++ includeGmp) + , arg ("--gcc-options=" ++ includeGmp) ] ] + , package runGhc + ? builder Ghc ? input "//Main.hs" ? pure ["-cpp", "-DVERSION=" ++ show version] + , package rts + ? builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling" + ] diff --git a/src/Settings/Packages/Haskeline.hs b/src/Settings/Packages/Haskeline.hs deleted file mode 100644 index 254c6b704c..0000000000 --- a/src/Settings/Packages/Haskeline.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Settings.Packages.Haskeline (haskelinePackageArgs) where - -import Expression -import Oracles.Flag (crossCompiling) - -haskelinePackageArgs :: Args -haskelinePackageArgs = - package haskeline ? builder GhcCabal ? crossCompiling ? arg "-f-terminfo" diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index fcbd795de0..da17f17b82 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -4,6 +4,7 @@ module Settings.Packages.Rts ( import Base import Expression +import GHC.Packages import Oracles.Flag import Oracles.Setting import Settings diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index 19a12df5fe..2e3c50bacf 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -1,6 +1,7 @@ module Settings.Warnings (defaultGhcWarningsArgs, warningArgs) where import Expression +import GHC.Packages import Oracles.Flag import Oracles.Setting import Settings diff --git a/src/UserSettings.hs b/src/UserSettings.hs index a1a82dc598..37fc06330e 100644 --- a/src/UserSettings.hs +++ b/src/UserSettings.hs @@ -7,8 +7,6 @@ module UserSettings ( buildProgressColour, successColour, stage1Only ) where -import Hadrian.Utilities - import Flavour import Expression import {-# SOURCE #-} Settings.Default @@ -18,7 +16,7 @@ import {-# SOURCE #-} Settings.Default -- | All build results are put into the 'buildRoot' directory. userBuildRoot :: BuildRoot -userBuildRoot = BuildRoot "_build" +userBuildRoot = error "build root not set" -- BuildRoot "_build" -- | User-defined build flavours. See 'userFlavour' as an example. userFlavours :: [Flavour] diff --git a/src/Utilities.hs b/src/Utilities.hs index fc898c35b9..d178a9deac 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -1,19 +1,22 @@ module Utilities ( - build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith, + build, buildWithResources, buildWithCmdOptions, + askWithResources, + runBuilder, runBuilderWith, needLibrary, contextDependencies, stage1Dependencies, libraryTargets, - topsortPackages + topsortPackages, cabalDependencies ) where import qualified Hadrian.Builder as H import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Hadrian.Utilities import Context import Expression hiding (stage) -import Oracles.PackageData +import GHC.Packages +import Oracles.Setting (windowsHost) import Settings import Target -import UserSettings build :: Target -> Action () build target = H.build target getArgs @@ -24,6 +27,9 @@ buildWithResources rs target = H.buildWithResources rs target getArgs buildWithCmdOptions :: [CmdOption] -> Target -> Action () buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs +askWithResources :: [(Resource, Int)] -> Target -> Action String +askWithResources rs target = H.askWithResources rs target getArgs + -- TODO: Cache the computation. -- | Given a 'Context' this 'Action' looks up the package dependencies and wraps -- the results in appropriate contexts. The only subtlety here is that we never @@ -32,7 +38,7 @@ buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs -- dependencies we transitively scan @.cabal@ files using 'pkgDependencies' -- defined in "Hadrian.Haskell.Cabal". contextDependencies :: Context -> Action [Context] -contextDependencies Context {..} = do +contextDependencies ctx@Context {..} = do depPkgs <- go [package] return [ Context depStage pkg way | pkg <- depPkgs, pkg /= package ] where @@ -41,12 +47,15 @@ contextDependencies Context {..} = do deps <- concatMapM step pkgs let newPkgs = nubOrd $ sort (deps ++ pkgs) if pkgs == newPkgs then return pkgs else go newPkgs - step pkg = case pkgCabalFile pkg of - Nothing -> return [] -- Non-Cabal packages have no dependencies. - Just cabalFile -> do - deps <- pkgDependencies cabalFile - active <- sort <$> stagePackages depStage - return $ intersectOrd (compare . pkgName) active deps + step pkg = pkgDependencies (ctx { Context.package = pkg }) >>= \case + Nothing -> return [] -- non cabal package => no dependencies + Just deps -> do + active <- sort <$> stagePackages depStage + return $ intersectOrd (compare . pkgName) active deps + +cabalDependencies :: Context -> Action [String] +cabalDependencies ctx = interpretInContext ctx $ + getConfiguredCabalData ConfCabal.depIpIds -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context. stage1Dependencies :: Package -> Action [Package] @@ -57,16 +66,19 @@ stage1Dependencies = -- 'packageTargets' for the explanation of the @includeGhciLib@ parameter. libraryTargets :: Bool -> Context -> Action [FilePath] libraryTargets includeGhciLib context = do - confFile <- pkgConfFile context libFile <- pkgLibraryFile context lib0File <- pkgLibraryFile0 context lib0 <- buildDll0 context ghciLib <- pkgGhciLibraryFile context - ghciFlag <- if includeGhciLib - then interpretInContext context $ getPkgData BuildGhciLib - else return "NO" - let ghci = ghciFlag == "YES" && (stage context == Stage1 || stage1Only) - return $ [ confFile, libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ] + ghci <- if includeGhciLib + then interpretInContext context $ getConfiguredCabalData ConfCabal.buildGhciLib + else return False + return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ] + + where buildDll0 :: Context -> Action Bool + buildDll0 Context {..} = do + windows <- windowsHost + return $ windows && stage == Stage1 && package == compiler -- | Coarse-grain 'need': make sure all given libraries are fully built. needLibrary :: [Context] -> Action () From 8298dad7b452c4a48e678024e001245c1b218183 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 19 Mar 2018 16:37:36 +0100 Subject: [PATCH 02/28] fix documentation rules --- src/Builder.hs | 4 ++-- src/Rules/Documentation.hs | 14 ++++++++------ src/Settings/Builders/Haddock.hs | 14 ++++++++++---- 3 files changed, 20 insertions(+), 12 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index ed160ba61f..b66a47c184 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -139,8 +139,8 @@ builderProvenance = \case GhcCabal _ _ -> context Stage1 ghcCabal GhcPkg _ Stage0 -> Nothing GhcPkg _ _ -> context Stage0 ghcPkg - Haddock _ -> context Stage2 haddock - Hpc -> context Stage1 hpcBin + Haddock _ -> context Stage1 haddock + Hpc -> context Stage0 hpcBin Hp2Ps -> context Stage0 hp2ps Hsc2Hs _ -> context Stage0 hsc2hs Unlit -> context Stage0 unlit diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 53421d657a..490d4c7a8b 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -21,12 +21,13 @@ import qualified Hadrian.Haskell.Cabal.Configured as ConfCabal -- | Build all documentation documentationRules :: Rules () documentationRules = do + root <- buildRootRules buildHtmlDocumentation buildPdfDocumentation buildDocumentationArchives buildManPage - "//docs//gen_contents_index" %> copyFile "libraries/gen_contents_index" - "//docs//prologue.txt" %> copyFile "libraries/prologue.txt" + root -/- htmlRoot -/- "libraries/gen_contents_index" %> copyFile "libraries/gen_contents_index" + root -/- htmlRoot -/- "libraries/prologue.txt" %> copyFile "libraries/prologue.txt" "docs" ~> do root <- buildRoot let html = htmlRoot -/- "index.html" @@ -35,10 +36,10 @@ documentationRules = do need $ map (root -/-) $ [html] ++ archives ++ pdfs need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" ] need [ root -/- htmlRoot -/- "libraries" -/- "prologue.txt" ] - need [manPagePath] + need [ root -/- manPagePath ] manPagePath :: FilePath -manPagePath = "_build/docs/users_guide/build-man/ghc.1" +manPagePath = "docs/users_guide/build-man/ghc.1" -- TODO: Add support for Documentation Packages so we can -- run the builders without this hack. @@ -114,7 +115,7 @@ buildLibraryDocumentation = do let libDocs = filter (\x -> takeFileName x `notElem` ["ghc.haddock", "rts.haddock"]) haddocks - context = vanillaContext Stage2 docPackage + context = vanillaContext Stage1 docPackage need libDocs build $ target context (Haddock BuildIndex) libDocs [file] @@ -208,7 +209,8 @@ buildArchive path = do -- | build man page buildManPage :: Rules () buildManPage = do - manPagePath %> \file -> do + root <- buildRootRules + root -/- manPagePath %> \file -> do need ["docs/users_guide/ghc.rst"] let context = vanillaContext Stage0 docPackage withTempDir $ \dir -> do diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index fa987cd681..0d3ccd8da6 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -16,8 +16,11 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat [ builder (Haddock BuildIndex) ? do output <- getOutput inputs <- getInputs + root <- getBuildRoot mconcat - [ arg "--gen-index" + [ arg $ "-B" ++ root -/- "stage1" -/- "lib" + , arg $ "--lib=" ++ root -/- "lib" + , arg "--gen-index" , arg "--gen-contents" , arg "-o", arg $ takeDirectory output , arg "-t", arg "Haskell Hierarchical Libraries" @@ -29,6 +32,7 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat , builder (Haddock BuildPackage) ? do output <- getOutput pkg <- getPackage + root <- getBuildRoot path <- getBuildPath Just version <- expr $ pkgVersion ctx Just synopsis <- expr $ pkgSynopsis ctx @@ -37,7 +41,9 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs mconcat - [ arg "--verbosity=0" + [ arg $ "-B" ++ root -/- "stage1" -/- "lib" + , arg $ "--lib=" ++ root -/- "lib" + , arg "--verbosity=0" , arg $ "--odir=" ++ takeDirectory output , arg "--no-tmp-comp-dir" , arg $ "--dump-interface=" ++ output @@ -47,14 +53,14 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat , arg "--quickjump" , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis - , arg $ "--prologue=" ++ path -/- "haddock-prologue.txt" + , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt" , arg $ "--optghc=-D__HADDOCK_VERSION__=" ++ show (versionToInt hVersion) , map ("--hide=" ++) <$> getConfiguredCabalData ConfCabal.otherModules , pure [ "--read-interface=../" ++ dep ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME}," ++ haddock | (dep, haddock) <- zip deps haddocks ] - , pure [ "--optghc=" ++ opt | opt <- ghcOpts ] + , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ] , getInputs , arg "+RTS" , arg $ "-t" ++ path -/- "haddock.t" From 42f5b6fb7f11b097d0b8ae2a4b3e6a012ee63505 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 19 Mar 2018 18:22:21 +0100 Subject: [PATCH 03/28] remove some leftover unrelated, commented-out code --- src/Rules.hs | 50 -------------------------------------------------- 1 file changed, 50 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 970d2a5faa..e226bfee12 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -30,56 +30,6 @@ allStages = [minBound .. maxBound] -- 'Stage1Only' flag. topLevelTargets :: Rules () topLevelTargets = do -{- phony "binary-dist" $ do - -- This is kind of incorrect. We should not "need" a phony rule. - -- Instead we should *need* the libraries and binaries we want to - -- put into the binary distribution. For now we will just *need* - -- stage2 and package up bin and lib. - need ["stage2", "docs"] - version <- setting ProjectVersion - cwd <- liftIO getCurrentDirectory - binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" - baseDir <- buildRoot <&> (-/- stageString Stage1) - targetPlatform <- setting TargetPlatformFull - - -- prepare binary distribution configure script - copyFile (cwd -/- "aclocal.m4") (cwd -/- "distrib" -/- "aclocal.m4") - buildWithCmdOptions [Cwd $ cwd -/- "distrib"] $ - target (vanillaContext Stage1 ghc) (Autoreconf $ cwd -/- "distrib") [] [] - - let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform - bindistFilesDir = baseDir -/- ghcVersionPretty - createDirectory bindistFilesDir - - -- copy config.sub, config.guess, install-sh, Makefile files, etc - -- from the source of the tree to the bindist dir - copyFile (cwd -/- "distrib" -/- "configure") (bindistFilesDir -/- "configure") - copyFile (cwd -/- "distrib" -/- "Makefile") (bindistFilesDir -/- "Makefile") - copyFile (cwd -/- "install-sh") (bindistFilesDir -/- "install-sh") - copyFile (cwd -/- "config.sub") (bindistFilesDir -/- "config.sub") - copyFile (cwd -/- "config.guess") (bindistFilesDir -/- "config.guess") - copyFile (cwd -/- "settings.in") (bindistFilesDir -/- "settings.in") - copyFile (cwd -/- "mk" -/- "config.mk.in") (bindistFilesDir -/- "mk" -/- "config.mk.in") - copyFile (cwd -/- "mk" -/- "install.mk.in") (bindistFilesDir -/- "mk" -/- "install.mk.in") - copyDirectory (baseDir -/- "bin") bindistFilesDir - copyDirectory (baseDir -/- "lib") bindistFilesDir - copyDirectory (takeDirectory baseDir -/- "docs") bindistFilesDir - - -- TODO: move stage1/bin, stage1/lib and all the files above to some - -- other (temporary?) directory, and invoke tar there - -- TODO: test with another flavour than quick-with-ng - - buildWithCmdOptions [Cwd baseDir] $ - -- ghc is a fake package here. - target (vanillaContext Stage1 ghc) (Tar Create) - [ ghcVersionPretty ] - {- [ "bin", "lib", "docs", "configure", "config.sub", "config.guess" - , "install-sh", "settings.in", "mk/config.mk.in", "mk/install.mk.in" - , "Makefile" - ] -} - [binDistDir -/- ghcVersionPretty ++ ".tar.xz"] --} - phony "stage2" $ do putNormal "Building stage2" (programs, libraries) <- partition isProgram <$> stagePackages Stage1 From 0f85e35317cae8957c9fd8f6c5a1d98027e6308c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 20 Mar 2018 15:44:27 +0100 Subject: [PATCH 04/28] more documentation fixes, address some feedback --- src/Base.hs | 10 ++++++--- src/Builder.hs | 2 +- src/CommandLine.hs | 2 +- src/Hadrian/Haskell/Cabal/Configured.hs | 12 ++-------- src/Rules/Documentation.hs | 29 +++++++++++++------------ src/Settings/Builders/Haddock.hs | 8 +++---- src/UserSettings.hs | 6 +---- 7 files changed, 31 insertions(+), 38 deletions(-) diff --git a/src/Base.hs b/src/Base.hs index 0f9eaf00e7..29f1aeb694 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -24,7 +24,7 @@ module Base ( hadrianPath, configPath, configFile, sourcePath, shakeFilesDir, generatedDir, generatedPath, stageBinPath, stageLibPath, -templateHscPath, ghcDeps, + templateHscPath, ghcDeps, relativePackageDbPath, packageDbPath, packageDbStamp, ghcSplitPath ) where @@ -83,11 +83,13 @@ generatedDir = "generated" generatedPath :: Action FilePath generatedPath = buildRoot <&> (-/- generatedDir) --- | Path to the inplace package database used in 'Stage1' and later. +-- | Path to the package database for the given stage of GHC, +-- relative to the build root. relativePackageDbPath :: Stage -> FilePath relativePackageDbPath stage = stageString stage -/- "lib" -/- "package.conf.d" --- | Path to the package database used in a given 'Stage'. +-- | Path to the package database used in a given 'Stage', including +-- the build root. packageDbPath :: Stage -> Action FilePath packageDbPath stage = buildRoot <&> (-/- relativePackageDbPath stage) @@ -95,9 +97,11 @@ packageDbPath stage = buildRoot <&> (-/- relativePackageDbPath stage) packageDbStamp :: FilePath packageDbStamp = ".stamp" +-- | @bin@ directory for the given 'Stage' (including the build root) stageBinPath :: Stage -> Action FilePath stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin") +-- | @lib@ directory for the given 'Stage' (including the build root) stageLibPath :: Stage -> Action FilePath stageLibPath stage = buildRoot <&> (-/- stageString stage -/- "lib") diff --git a/src/Builder.hs b/src/Builder.hs index b66a47c184..220a31a786 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -140,7 +140,7 @@ builderProvenance = \case GhcPkg _ Stage0 -> Nothing GhcPkg _ _ -> context Stage0 ghcPkg Haddock _ -> context Stage1 haddock - Hpc -> context Stage0 hpcBin + Hpc -> context Stage1 hpcBin Hp2Ps -> context Stage0 hp2ps Hsc2Hs _ -> context Stage0 hsc2hs Unlit -> context Stage0 unlit diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 6a63fef15f..68e8b4ce06 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -38,7 +38,7 @@ defaultCommandLineArgs = CommandLineArgs , progressColour = Auto , progressInfo = Brief , splitObjects = False - , buildRoot = UserSettings.userBuildRoot + , buildRoot = BuildRoot "_build" , testArgs = defaultTestArgs } -- | These arguments are used by the `test` target. diff --git a/src/Hadrian/Haskell/Cabal/Configured.hs b/src/Hadrian/Haskell/Cabal/Configured.hs index e20faae30e..90d60ba3b4 100644 --- a/src/Hadrian/Haskell/Cabal/Configured.hs +++ b/src/Hadrian/Haskell/Cabal/Configured.hs @@ -43,13 +43,5 @@ data ConfiguredCabal = ConfiguredCabal instance Binary ConfiguredCabal -instance Hashable ConfiguredCabal where - hashWithSalt salt = hashWithSalt salt . show - -instance NFData ConfiguredCabal where - rnf (ConfiguredCabal a b c d e f g h i j k l m n o p q r s t u v w x z y - aa ab ac ad ae af) - = a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` g `seq` h `seq` i `seq` j - `seq` k `seq` l `seq` m `seq` n `seq` o `seq` p `seq` q `seq` r `seq` s `seq` t - `seq` u `seq` v `seq` w `seq` x `seq` y `seq` z `seq` aa `seq` ab `seq` ac `seq` ad - `seq` ae `seq` af `seq` () +instance Hashable ConfiguredCabal +instance NFData ConfiguredCabal diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 490d4c7a8b..f3b0d2aa4c 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -100,7 +100,7 @@ buildSphinxHtml path = do root <- buildRootRules root -/- htmlRoot -/- path -/- "index.html" %> \file -> do let dest = takeDirectory file - context = vanillaContext Stage0 docPackage + context = vanillaContext Stage1 docPackage build $ target context (Sphinx Html) [pathPath path] [dest] ----------------------------- @@ -110,13 +110,20 @@ buildSphinxHtml path = do buildLibraryDocumentation :: Rules () buildLibraryDocumentation = do root <- buildRootRules + + -- Js and Css files for haddock output + root -/- haddockHtmlLib %> \d -> do + let dir = takeDirectory d + liftIO $ removeFiles dir ["//*"] + copyDirectory "utils/haddock/haddock-api/resources/html" dir + root -/- htmlRoot -/- "libraries/index.html" %> \file -> do haddocks <- allHaddocks let libDocs = filter (\x -> takeFileName x `notElem` ["ghc.haddock", "rts.haddock"]) haddocks context = vanillaContext Stage1 docPackage - need libDocs + need (root -/- haddockHtmlLib : libDocs) build $ target context (Haddock BuildIndex) libDocs [file] allHaddocks :: Action [FilePath] @@ -125,8 +132,8 @@ allHaddocks = do sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ] -haddockHtmlLib :: FilePath -> FilePath -haddockHtmlLib root = root -/- "lib/html/haddock-bundle.min.js" +haddockHtmlLib ::FilePath +haddockHtmlLib = "docs/html/haddock-bundle.min.js" -- | Find the haddock files for the dependencies of the current library haddockDependencies :: Context -> Action [FilePath] @@ -142,12 +149,6 @@ buildPackageDocumentation :: Context -> Rules () buildPackageDocumentation context@Context {..} = when (stage == Stage1 && package /= rts) $ do root <- buildRootRules - -- Js and Css files for haddock output - when (package == haddock) $ haddockHtmlLib root %> \_ -> do - let dir = takeDirectory (haddockHtmlLib root) - liftIO $ removeFiles dir ["//*"] - copyDirectory "utils/haddock/haddock-api/resources/html" dir - -- Per-package haddocks root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" %> \file -> do -- this is how ghc-cabal produces "haddock-prologue.txt" files @@ -162,7 +163,7 @@ buildPackageDocumentation context@Context {..} = when (stage == Stage1 && packag need [ root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" ] haddocks <- haddockDependencies context srcs <- hsSources context - need $ srcs ++ haddocks ++ [haddockHtmlLib root] + need $ srcs ++ haddocks ++ [root -/- haddockHtmlLib] -- Build Haddock documentation -- TODO: pass the correct way from Rules via Context @@ -183,7 +184,7 @@ buildSphinxPdf :: FilePath -> Rules () buildSphinxPdf path = do root <- buildRootRules root -/- pdfRoot -/- path <.> "pdf" %> \file -> do - let context = vanillaContext Stage0 docPackage + let context = vanillaContext Stage1 docPackage withTempDir $ \dir -> do build $ target context (Sphinx Latex) [pathPath path] [dir] build $ target context Xelatex [path <.> "tex"] [dir] @@ -201,7 +202,7 @@ buildArchive path = do root <- buildRootRules root -/- pathArchive path %> \file -> do root <- buildRoot - let context = vanillaContext Stage0 docPackage + let context = vanillaContext Stage1 docPackage src = root -/- pathIndex path need [src] build $ target context (Tar Create) [takeDirectory src] [file] @@ -212,7 +213,7 @@ buildManPage = do root <- buildRootRules root -/- manPagePath %> \file -> do need ["docs/users_guide/ghc.rst"] - let context = vanillaContext Stage0 docPackage + let context = vanillaContext Stage1 docPackage withTempDir $ \dir -> do build $ target context (Sphinx Man) ["docs/users_guide"] [dir] copyFileUntracked (dir -/- "ghc.1") file diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index 0d3ccd8da6..59708587d6 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -19,7 +19,7 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat root <- getBuildRoot mconcat [ arg $ "-B" ++ root -/- "stage1" -/- "lib" - , arg $ "--lib=" ++ root -/- "lib" + , arg $ "--lib=" ++ root -/- "docs" , arg "--gen-index" , arg "--gen-contents" , arg "-o", arg $ takeDirectory output @@ -41,9 +41,9 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs mconcat - [ arg $ "-B" ++ root -/- "stage1" -/- "lib" - , arg $ "--lib=" ++ root -/- "lib" - , arg "--verbosity=0" + [ arg "--verbosity=0" + , arg $ "-B" ++ root -/- "stage1" -/- "lib" + , arg $ "--lib=" ++ root -/- "docs" , arg $ "--odir=" ++ takeDirectory output , arg "--no-tmp-comp-dir" , arg $ "--dump-interface=" ++ output diff --git a/src/UserSettings.hs b/src/UserSettings.hs index 37fc06330e..e52ed68ee7 100644 --- a/src/UserSettings.hs +++ b/src/UserSettings.hs @@ -3,7 +3,7 @@ -- If you don't copy the file your changes will be tracked by git and you can -- accidentally commit them. module UserSettings ( - userBuildRoot, userFlavours, userPackages, verboseCommand, + userFlavours, userPackages, verboseCommand, buildProgressColour, successColour, stage1Only ) where @@ -14,10 +14,6 @@ import {-# SOURCE #-} Settings.Default -- See doc/user-settings.md for instructions. -- Please update doc/user-settings.md when committing changes to this file. --- | All build results are put into the 'buildRoot' directory. -userBuildRoot :: BuildRoot -userBuildRoot = error "build root not set" -- BuildRoot "_build" - -- | User-defined build flavours. See 'userFlavour' as an example. userFlavours :: [Flavour] userFlavours = [userFlavour] -- Add more build flavours if need be. From e23a3d950415272e6558e6e3278c6a69b82583e8 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 21 Mar 2018 07:10:18 +0100 Subject: [PATCH 05/28] cleanup --- src/Hadrian/Haskell/Cabal/Type.hs | 3 +-- src/Rules.hs | 4 ---- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Type.hs b/src/Hadrian/Haskell/Cabal/Type.hs index 5aafa742c1..1383051c34 100644 --- a/src/Hadrian/Haskell/Cabal/Type.hs +++ b/src/Hadrian/Haskell/Cabal/Type.hs @@ -20,5 +20,4 @@ instance Binary Cabal instance Hashable Cabal where hashWithSalt salt = hashWithSalt salt . show -instance NFData Cabal where - rnf (Cabal a b c d e f) = a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` () +instance NFData Cabal diff --git a/src/Rules.hs b/src/Rules.hs index e226bfee12..e33f24bcf4 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -132,7 +132,3 @@ oracleRules = do Hadrian.Oracles.Path.pathOracle Hadrian.Oracles.TextFile.textFileOracle Oracles.ModuleFiles.moduleFilesOracle - --- programsStage1Only :: [Package] --- programsStage1Only = [ deriveConstants, genapply, genprimopcode, ghc, ghcCabal --- , ghcPkg, hp2ps, hpc, hsc2hs, runGhc ] From c99df2cadb50e1db5353b71872b5178ac1b16706 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 21 Mar 2018 14:24:16 +0100 Subject: [PATCH 06/28] more cleanup --- src/Rules/Test.hs | 17 ++++++++++++----- src/Settings/Default.hs | 6 +++--- 2 files changed, 15 insertions(+), 8 deletions(-) diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 6964639dd4..426c049d4f 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -34,14 +34,12 @@ testRules = do makeExecutable (root -/- timeoutProgPath) "validate" ~> do - needBuilder $ Ghc CompileHs Stage2 - needBuilder $ GhcPkg Update Stage1 - needBuilder Hp2Ps - needBuilder Hpc - needBuilder (Hsc2Hs Stage1) + needTestBuilders build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] [] "test" ~> do + needTestBuilders + -- Prepare the timeout program. need [ root -/- timeoutProgPath ] @@ -66,6 +64,15 @@ testRules = do -- Execute the test target. buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] [] +needTestBuilders :: Action () +needTestBuilders = do + needBuilder $ Ghc CompileHs Stage2 + needBuilder $ GhcPkg Update Stage1 + needBuilder Hp2Ps + needBuilder Hpc + needBuilder (Hsc2Hs Stage1) + + -- | Extra flags to send to the Haskell compiler to run tests. runTestGhcFlags :: Action String runTestGhcFlags = do diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index edc4025180..663d1b85d2 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -89,9 +89,9 @@ defaultRtsWays = do mconcat [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ] , (profiling `elem` ways) ? pure [threadedProfiling] - -- , (dynamic `elem` ways) ? - -- pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic - -- , loggingDynamic, threadedLoggingDynamic ] + , (dynamic `elem` ways) ? + pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic + , loggingDynamic, threadedLoggingDynamic ] ] -- Please update doc/flavours.md when changing the default build flavour. From edb7fa99d2d5a96a3b86dd02457974d0f7182e53 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 21 Mar 2018 15:14:43 +0100 Subject: [PATCH 07/28] boot and configure explicitly in travis CI scripts --- .travis.yml | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/.travis.yml b/.travis.yml index 63b3e31a59..68f462b031 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ sudo: true matrix: include: - os: linux - env: MODE="--flavour=quickest inplace/bin/ghc-stage1" + env: MODE="--flavour=quickest _build/stage0/bin/ghc" compiler: "GHC 8.0.2" addons: apt: @@ -17,14 +17,17 @@ matrix: - PATH="/opt/cabal/2.0/bin:$PATH" script: + # boot and configure ghc's source tree + - ./boot --hadrian && ./configure + # Run internal Hadrian tests - - ./build.sh -c selftest + - hadrian/build.sh selftest # Build GHC - - ./build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- + - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- - os: linux - env: MODE="--flavour=quickest --integer-simple" + env: MODE="--flavour=quickest --integer-simple stage2" compiler: "GHC 8.2.1" addons: apt: @@ -39,24 +42,29 @@ matrix: - PATH="/opt/cabal/1.22/bin:$PATH" script: + # boot and configure ghc's source tree + - ./boot --hadrian && ./configure + # Build GHC - - ./build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- + - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- # Test GHC binary - - cd .. - - inplace/bin/ghc-stage2 -e 1+2 + - _build/stage1/bin/ghc -e 1+2 - os: osx osx_image: xcode8 - env: MODE="--flavour=quickest --integer-simple inplace/bin/ghc-stage1" + env: MODE="--flavour=quickest --integer-simple _build/stage0/bin/ghc" before_install: - brew update - brew install ghc cabal-install python3 script: + # boot and configure ghc's source tree + - ./boot --hadrian && ./configure + # Due to timeout limit of OS X build on Travis CI, # we will ignore selftest and build only stage1 - - ./build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- + - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- install: # Add Cabal to PATH @@ -83,8 +91,7 @@ install: # to ./ghc/hadrian -- one way to do it is to move the .git directory # and perform a hard reset in order to regenerate Hadrian files - mv .git ghc/hadrian - - cd ghc/hadrian - - git reset --hard HEAD + - cd ghc/hadrian && git reset --hard HEAD && cd .. cache: directories: From e8daefca927254ad7b0bfe4774667e899da36f5c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 21 Mar 2018 17:59:49 +0100 Subject: [PATCH 08/28] update cabal/ghc versions in .travis.yml (8.0.x not supported anymore) --- .travis.yml | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/.travis.yml b/.travis.yml index 68f462b031..3b050571f1 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,18 +3,18 @@ matrix: include: - os: linux env: MODE="--flavour=quickest _build/stage0/bin/ghc" - compiler: "GHC 8.0.2" + compiler: "GHC 8.2.2" addons: apt: packages: - - ghc-8.0.2 - - cabal-install-2.0 + - ghc-8.2.2 + - cabal-install-1.22 - zlib1g-dev sources: hvr-ghc before_install: - - PATH="/opt/ghc/8.0.2/bin:$PATH" - - PATH="/opt/cabal/2.0/bin:$PATH" + - PATH="/opt/ghc/8.2.2/bin:$PATH" + - PATH="/opt/cabal/1.22/bin:$PATH" script: # boot and configure ghc's source tree @@ -28,18 +28,18 @@ matrix: - os: linux env: MODE="--flavour=quickest --integer-simple stage2" - compiler: "GHC 8.2.1" + compiler: "GHC 8.4.1" addons: apt: packages: - - ghc-8.2.1 - - cabal-install-1.22 + - ghc-8.4.1 + - cabal-install-2.2 - zlib1g-dev sources: hvr-ghc before_install: - - PATH="/opt/ghc/8.2.1/bin:$PATH" - - PATH="/opt/cabal/1.22/bin:$PATH" + - PATH="/opt/ghc/8.4.1/bin:$PATH" + - PATH="/opt/cabal/2.2/bin:$PATH" script: # boot and configure ghc's source tree From cab4c6de6c0a8df03606186b23bdcaf815fdc5bd Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 22 Mar 2018 10:34:40 +0100 Subject: [PATCH 09/28] temporarily disable dynamic ways in Settings.Default --- .travis.yml | 4 ++-- src/Settings/Default.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index 3b050571f1..6492fc7430 100644 --- a/.travis.yml +++ b/.travis.yml @@ -8,13 +8,13 @@ matrix: apt: packages: - ghc-8.2.2 - - cabal-install-1.22 + - cabal-install-2.0 - zlib1g-dev sources: hvr-ghc before_install: - PATH="/opt/ghc/8.2.2/bin:$PATH" - - PATH="/opt/cabal/1.22/bin:$PATH" + - PATH="/opt/cabal/2.0/bin:$PATH" script: # boot and configure ghc's source tree diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 663d1b85d2..988e847272 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -89,9 +89,9 @@ defaultRtsWays = do mconcat [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ] , (profiling `elem` ways) ? pure [threadedProfiling] - , (dynamic `elem` ways) ? + {- , (dynamic `elem` ways) ? pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic - , loggingDynamic, threadedLoggingDynamic ] + , loggingDynamic, threadedLoggingDynamic ] -} ] -- Please update doc/flavours.md when changing the default build flavour. From 6c29fe22039b0cf71935acf1cd01942f6df3c91d Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 22 Mar 2018 12:24:27 +0100 Subject: [PATCH 10/28] update appveyor script --- appveyor.yml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/appveyor.yml b/appveyor.yml index 32fc436763..87becefc4c 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -30,11 +30,16 @@ install: - appveyor-retry stack exec -- pacman -S autoconf automake-wrapper make patch python tar --noconfirm build_script: + # Boot and configure ghc source tree + - cd .. + - python boot && configure --enable-tarballs-autodownload + - cd hadrian + # Build Hadrian and run internal Hadrian tests - - build -c selftest + - build selftest # Build GHC - - build -j -c --flavour=quickest --no-progress --progress-colour=never --profile=- + - build -j --flavour=quickest --no-progress --progress-colour=never --profile=- stage2 # Test GHC binary - cd .. From e4204f10335e86e317a2d3446114a6a2bdaf9cdc Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 22 Mar 2018 18:45:39 +0100 Subject: [PATCH 11/28] travis: when booting with 8.2.2, build a complete stage2 compiler --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 6492fc7430..aac4fe5576 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ sudo: true matrix: include: - os: linux - env: MODE="--flavour=quickest _build/stage0/bin/ghc" + env: MODE="--flavour=quickest stage2" compiler: "GHC 8.2.2" addons: apt: From 3c5da999626117ce2d6f02a38efaebe60dc18c31 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 23 Mar 2018 11:18:36 +0800 Subject: [PATCH 12/28] Fix CI? Try to fix the CI by adding the `debug` rts way back in. --- src/Settings/Flavours/Quickest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Flavours/Quickest.hs b/src/Settings/Flavours/Quickest.hs index a9dfb7087f..3961ab44bc 100644 --- a/src/Settings/Flavours/Quickest.hs +++ b/src/Settings/Flavours/Quickest.hs @@ -20,4 +20,4 @@ quickestArgs = sourceArgs SourceArgs , hsGhc = stage0 ? arg "-O" } quickestRtsWays :: Ways -quickestRtsWays = pure [vanilla, threaded] +quickestRtsWays = pure [debug, vanilla, threaded] From 6052655539a397e0f29f2f3e8c1f6e56ab039e33 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 23 Mar 2018 12:04:43 +0800 Subject: [PATCH 13/28] Update Quickest.hs Replicate the make build systems build flavours. --- src/Settings/Flavours/Quickest.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Settings/Flavours/Quickest.hs b/src/Settings/Flavours/Quickest.hs index 3961ab44bc..836b935393 100644 --- a/src/Settings/Flavours/Quickest.hs +++ b/src/Settings/Flavours/Quickest.hs @@ -19,5 +19,10 @@ quickestArgs = sourceArgs SourceArgs , hsCompiler = stage0 ? arg "-O" , hsGhc = stage0 ? arg "-O" } +-- Replicate GHCs RtsWays for flavour quickest (without dynamic): +-- $ make show! VALUE=GhcLibWays +-- GhcLibWays="v" +-- $ make show! VALUE=GhcRTSWays +-- GhcRTSWays="l debug thr thr_debug thr_l" quickestRtsWays :: Ways -quickestRtsWays = pure [debug, vanilla, threaded] +quickestRtsWays = pure [vanilla, logging, debug, threaded, threadedDebug, threadedLogging] From 7764235ad1bb2089f9e54b457c502c0aa8670caa Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 23 Mar 2018 14:08:23 +0800 Subject: [PATCH 14/28] Update .travis.yml - Run selftest, and build in separate instances. - try with python2 - and unify mac to stage2 --- .travis.yml | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index aac4fe5576..728b6eab16 100644 --- a/.travis.yml +++ b/.travis.yml @@ -22,6 +22,25 @@ matrix: # Run internal Hadrian tests - hadrian/build.sh selftest + + - os: linux + env: MODE="--flavour=quickest stage2" + compiler: "GHC 8.2.2" + addons: + apt: + packages: + - ghc-8.2.2 + - cabal-install-2.0 + - zlib1g-dev + sources: hvr-ghc + + before_install: + - PATH="/opt/ghc/8.2.2/bin:$PATH" + - PATH="/opt/cabal/2.0/bin:$PATH" + + script: + # boot and configure ghc's source tree + - ./boot --hadrian && ./configure # Build GHC - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- @@ -53,10 +72,12 @@ matrix: - os: osx osx_image: xcode8 - env: MODE="--flavour=quickest --integer-simple _build/stage0/bin/ghc" + env: MODE="--flavour=quickest --integer-simple stage2" before_install: - brew update - - brew install ghc cabal-install python3 + - brew install ghc cabal-install + # do we really need python3? + # - brew upgrade python script: # boot and configure ghc's source tree From 9451654a7ccb07d4152d058ed0e8dbaa6e826ae4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 23 Mar 2018 14:22:28 +0800 Subject: [PATCH 15/28] Update .travis.yml upgrade python on mac --- .travis.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.travis.yml b/.travis.yml index 728b6eab16..d1108dfb56 100644 --- a/.travis.yml +++ b/.travis.yml @@ -2,7 +2,7 @@ sudo: true matrix: include: - os: linux - env: MODE="--flavour=quickest stage2" + env: MODE="selftest" compiler: "GHC 8.2.2" addons: apt: @@ -76,8 +76,7 @@ matrix: before_install: - brew update - brew install ghc cabal-install - # do we really need python3? - # - brew upgrade python + - brew upgrade python script: # boot and configure ghc's source tree From 81c736d873b5914d0811d09927dbfaf14bd97220 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Fri, 23 Mar 2018 16:13:32 +0100 Subject: [PATCH 16/28] [travis] os x: test the freshly built ghc --- .travis.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.travis.yml b/.travis.yml index d1108dfb56..121b31d77f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -86,6 +86,9 @@ matrix: # we will ignore selftest and build only stage1 - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- + # Test GHC binary + - _build/stage1/bin/ghc -e 1+2 + install: # Add Cabal to PATH - PATH="$HOME/.cabal/bin:$PATH" From a89b21f9278efe5834ccef59518e191ddc5238b2 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 26 Mar 2018 18:07:55 +0200 Subject: [PATCH 17/28] Get rid of two unused GhcCabalMode constructors --- src/Builder.hs | 2 +- src/Builder.hs-boot | 2 +- src/Settings/Builders/GhcCabal.hs | 15 +-------------- 3 files changed, 3 insertions(+), 16 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 220a31a786..13723418a2 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -56,7 +56,7 @@ instance Hashable GhcMode instance NFData GhcMode -- | GHC cabal mode. Can configure, copy and register pacakges. -data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist +data GhcCabalMode = Conf | HsColour | Check | Sdist deriving (Eq, Generic, Show) instance Binary GhcCabalMode diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index 05136dab6b..7ae43e07e3 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -8,7 +8,7 @@ import Development.Shake data CcMode = CompileC | FindCDependencies data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs -data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist +data GhcCabalMode = Conf | HsColour | Check | Sdist data GhcPkgMode = Init | Update | Clone | Dependencies data HaddockMode = BuildPackage | BuildIndex diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 29b99ed680..4ed06d6b6b 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -50,20 +50,7 @@ ghcCabalBuilderArgs = mconcat , "--configure-option=--disable-option-checking" ] ] - , builder (GhcCabal Copy) ? do - mconcat [ arg "copy" - , getInputs - ] - , builder (GhcCabal Reg) ? do - top <- expr topDirectory - path <- getContextPath - mconcat [ arg "register" - , arg =<< pkgPath <$> getPackage - , arg $ top -/- path - , stagedBuilderPath (Ghc CompileHs) - , stagedBuilderPath (GhcPkg Update) - , getInputs - ]] + ] -- TODO: Isn't vanilla always built? If yes, some conditions are redundant. From 7f5753c26d4ba064f357153e72d218d76008409d Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 27 Mar 2018 13:06:05 +0200 Subject: [PATCH 18/28] fix ghc-split rule, get rid of Install/Wrappers rules --- hadrian.cabal | 2 - src/Base.hs | 7 +- src/Builder.hs | 3 +- src/Main.hs | 2 - src/Rules.hs | 2 +- src/Rules/Generate.hs | 7 +- src/Rules/Install.hs | 350 ------------------------------------------ src/Rules/Wrappers.hs | 165 -------------------- 8 files changed, 11 insertions(+), 527 deletions(-) delete mode 100644 src/Rules/Install.hs delete mode 100644 src/Rules/Wrappers.hs diff --git a/hadrian.cabal b/hadrian.cabal index c9f3fae651..61a4b8d230 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -59,7 +59,6 @@ executable hadrian , Rules.Documentation , Rules.Generate , Rules.Gmp - , Rules.Install , Rules.Libffi , Rules.Library , Rules.Program @@ -67,7 +66,6 @@ executable hadrian , Rules.Selftest , Rules.SourceDist , Rules.Test - , Rules.Wrappers , Settings , Settings.Builders.Alex , Settings.Builders.Common diff --git a/src/Base.hs b/src/Base.hs index 29f1aeb694..fea33a9b30 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -120,6 +120,7 @@ templateHscPath :: Stage -> Action FilePath templateHscPath stage = stageLibPath stage <&> (-/- "template-hsc.h") -- | @ghc-split@ is a Perl script used by GHC when run with @-split-objs@ flag. --- It is generated in "Rules.Generate". -ghcSplitPath :: FilePath -ghcSplitPath = "path/to/ghc-split" -- TODO: fix this +-- It is generated in "Rules.Generate". This function returns the path relative +-- to the build root under which we will copy @ghc-split@. +ghcSplitPath :: Stage -> FilePath +ghcSplitPath stage = stageString stage -/- "bin" -/- "ghc-split" diff --git a/src/Builder.hs b/src/Builder.hs index 13723418a2..3bbc92d38e 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -163,11 +163,12 @@ instance H.Builder Builder where Ghc _ Stage0 -> return [] Ghc _ stage -> do + root <- buildRoot win <- windowsHost touchyPath <- programPath (vanillaContext Stage0 touchy) unlitPath <- builderPath Unlit ghcdeps <- ghcDeps stage - return $ [ ghcSplitPath -- TODO: Make conditional on --split-objects + return $ [ root -/- ghcSplitPath stage -- TODO: Make conditional on --split-objects , unlitPath ] ++ ghcdeps ++ [ touchyPath | win ] diff --git a/src/Main.hs b/src/Main.hs index c206bfc9ed..c90b052a0f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,6 @@ import qualified Environment import qualified Rules import qualified Rules.Clean import qualified Rules.Documentation --- import qualified Rules.Install import qualified Rules.SourceDist import qualified Rules.Selftest import qualified Rules.Test @@ -44,7 +43,6 @@ main = do Rules.buildRules Rules.Documentation.documentationRules Rules.Clean.cleanRules - -- Rules.Install.installRules Rules.oracleRules Rules.Selftest.selftestRules Rules.SourceDist.sourceDistRules diff --git a/src/Rules.hs b/src/Rules.hs index e33f24bcf4..017f33f298 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -42,7 +42,7 @@ topLevelTargets = do targets <- mapM (f Stage1) =<< stagePackages Stage1 need targets where - -- either the package databae config file for libraries or + -- 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. diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index c582e2ea94..2bae8d2490 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -180,9 +180,10 @@ generateRules = do priority 2.0 $ (root -/- generatedDir -/- "ghcplatform.h") <~ generateGhcPlatformH priority 2.0 $ (root -/- generatedDir -/- "ghcversion.h") <~ generateGhcVersionH - ghcSplitPath %> \_ -> do - generate ghcSplitPath emptyTarget generateGhcSplit - makeExecutable ghcSplitPath + forM_ [Stage0 ..] $ \stage -> + root -/- ghcSplitPath stage %> \path -> do + generate path emptyTarget generateGhcSplit + makeExecutable path -- TODO: simplify, get rid of fake rts context root -/- generatedDir ++ "//*" %> \file -> do diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs deleted file mode 100644 index fb4fc97013..0000000000 --- a/src/Rules/Install.hs +++ /dev/null @@ -1,350 +0,0 @@ -module Rules.Install () where -{- -import Hadrian.Oracles.DirectoryContents -import qualified System.Directory as IO - -import Base -import Expression -import Oracles.Setting -import Rules -import Rules.Generate -import Rules.Libffi -import Rules.Wrappers -import Settings -import Settings.Packages.Rts -import Target -import Utilities - -{- | Install the built binaries etc. to the @destDir ++ prefix@. - -The installation prefix is usually @/usr/local@ on a Unix system. -The resulting tree structure is organized under @destDir ++ prefix@ as follows: - -* @bin@: executable wrapper scripts, installed by 'installBins', e.g. @ghc@. - -* @lib/ghc-/bin@: executable binaries/scripts, - installed by 'installLibExecs' and 'installLibExecScripts'. - -* @lib/ghc-/include@: headers etc., installed by 'installIncludes'. - -* @lib/ghc-/@: built packages, e.g. @base@, installed - by 'installPackages'. - -* @lib/ghc-/settings@ etc.: other files in @lib@ directory, - installed by 'installCommonLibs'. - -XXX (izgzhen): Do we need @INSTALL_OPTS@ in the make scripts? --} -installRules :: Rules () -installRules = - "install" ~> do - installIncludes - installPackageConf - installCommonLibs - installLibExecs - installLibExecScripts - installBins - installPackages - installDocs - --- TODO: Get rid of hard-coded list. --- | Binaries to install. -installBinPkgs :: [Package] -installBinPkgs = [ghc, ghcPkg, ghcSplit, hp2ps, hpc, hsc2hs, runGhc, unlit] - -getLibExecDir :: Action FilePath -getLibExecDir = installGhcLibDir <&> (-/- "bin") - --- ref: mk/config.mk --- | Command line tool for stripping. -stripCmdPath :: Action FilePath -stripCmdPath = do - targetPlatform <- setting TargetPlatform - top <- topDirectory - case targetPlatform of - "x86_64-unknown-mingw32" -> - return (top -/- "inplace/mingw/bin/strip.exe") - "arm-unknown-linux" -> - return ":" -- HACK: from the make-based system, see the ref above - _ -> return "strip" - --- ref: ghc.mk --- | Install executable scripts to @prefix/lib/bin@. -installLibExecScripts :: Action () -installLibExecScripts = do - libExecDir <- getLibExecDir - destDir <- getDestDir - installDirectory (destDir ++ libExecDir) - forM_ libExecScripts $ \script -> installScript script (destDir ++ libExecDir) - where - libExecScripts :: [FilePath] - libExecScripts = [ghcSplitPath] - --- ref: ghc.mk --- | Install executable binaries to @prefix/lib/bin@. -installLibExecs :: Action () -installLibExecs = do - libExecDir <- getLibExecDir - destDir <- getDestDir - installDirectory (destDir ++ libExecDir) - forM_ installBinPkgs $ \pkg -> - withInstallStage pkg $ \stage -> do - context <- programContext stage pkg - let bin = inplaceLibBinPath -/- programName context <.> exe - installProgram bin (destDir ++ libExecDir) - when (pkg == ghc) $ - moveFile (destDir ++ libExecDir -/- programName context <.> exe) - (destDir ++ libExecDir -/- "ghc" <.> exe) - --- ref: ghc.mk --- | Install executable wrapper scripts to @prefix/bin@. -installBins :: Action () -installBins = do - binDir <- setting InstallBinDir - libDir <- installGhcLibDir - destDir <- getDestDir - installDirectory (destDir ++ binDir) - win <- windowsHost - when win $ - copyDirectoryContents matchAll (destDir ++ libDir -/- "bin") (destDir ++ binDir) - unless win $ forM_ installBinPkgs $ \pkg -> - withInstallStage pkg $ \stage -> do - context <- programContext stage pkg - version <- setting ProjectVersion - -- Name of the binary file - let binName | pkg == ghc = "ghc-" ++ version <.> exe - | otherwise = programName context ++ "-" ++ version <.> exe - -- Name of the symbolic link - let symName | pkg == ghc = "ghc" <.> exe - | otherwise = programName context <.> exe - case lookup context installWrappers of - Nothing -> return () - Just wrapper -> do - contents <- interpretInContext context $ - wrapper (WrappedBinary (destDir ++ libDir) symName) - let wrapperPath = destDir ++ binDir -/- binName - writeFileChanged wrapperPath contents - makeExecutable wrapperPath - unlessM windowsHost $ - linkSymbolic (destDir ++ binDir -/- binName) - (destDir ++ binDir -/- symName) - --- | Perform an action depending on the install stage or do nothing if the --- package is not installed. -withInstallStage :: Package -> (Stage -> Action ()) -> Action () -withInstallStage pkg m = do - maybeStage <- installStage pkg - case maybeStage of { Just stage -> m stage; Nothing -> return () } - -pkgConfInstallPath :: Action FilePath -pkgConfInstallPath = buildPath (vanillaContext Stage0 rts) <&> (-/- "package.conf.install") - --- ref: rules/manual-package-conf.mk --- TODO: Should we use a temporary file instead of pkgConfInstallPath? --- | Install @package.conf.install@ for each package. Note that it will be --- recreated each time. -installPackageConf :: Action () -installPackageConf = do - let context = vanillaContext Stage0 rts - confPath <- pkgConfInstallPath - liftIO $ IO.createDirectoryIfMissing True (takeDirectory confPath) - build $ target context HsCpp [ pkgPath rts -/- "package.conf.in" ] - [ confPath <.> "raw" ] - Stdout content <- cmd "grep" [ "-v", "^#pragma GCC" - , confPath <.> "raw" ] - withTempFile $ \tmp -> do - liftIO $ writeFile tmp content - Stdout result <- cmd "sed" [ "-e", "s/\"\"//g", "-e", "s/:[ ]*,/: /g", tmp ] - liftIO $ writeFile confPath result - --- ref: ghc.mk --- | Install packages to @prefix/lib@. -installPackages :: Action () -installPackages = do - confPath <- pkgConfInstallPath - need [confPath] - - ghcLibDir <- installGhcLibDir - binDir <- setting InstallBinDir - destDir <- getDestDir - - -- Install package.conf - let installedPackageConf = destDir ++ ghcLibDir -/- "package.conf.d" - installDirectory (destDir ++ ghcLibDir) - removeDirectory installedPackageConf - installDirectory installedPackageConf - - -- Install RTS - let rtsDir = destDir ++ ghcLibDir -/- "rts" - installDirectory rtsDir - ways <- interpretInContext (vanillaContext Stage1 rts) getRtsWays - rtsLibs <- mapM (pkgLibraryFile . Context Stage1 rts) ways - ffiLibs <- mapM rtsLibffiLibrary ways - - -- TODO: Add dynamic libraries. - forM_ (rtsLibs ++ ffiLibs) $ \lib -> installData [lib] rtsDir - - -- TODO: Remove this hack required for @ghc-cabal copy@. - -- See https://github.com/snowleopard/hadrian/issues/327. - ghcBootPlatformHeader <- - buildPath (vanillaContext Stage1 compiler) <&> (-/- "ghc_boot_platform.h") - copyFile ghcBootPlatformHeader (pkgPath compiler -/- "ghc_boot_platform.h") - - installPackages <- filterM ((isJust <$>) . installStage) - (knownPackages \\ [rts, libffi]) - - installLibPkgs <- topsortPackages (filter isLibrary installPackages) - - -- TODO: Figure out what is the root cause of the missing ghc-gmp.h error. - copyFile (pkgPath integerGmp -/- "gmp/ghc-gmp.h") (pkgPath integerGmp -/- "ghc-gmp.h") - - forM_ installLibPkgs $ \pkg -> - case pkgCabalFile pkg of - Nothing -> error $ "Non-Haskell project in installLibPkgs" ++ show pkg - Just cabalFile -> withInstallStage pkg $ \stage -> do - let context = vanillaContext stage pkg - top <- topDirectory - installDistDir <- buildPath context - let absInstallDistDir = top -/- installDistDir - - need =<< packageTargets True stage pkg - docDir <- installDocDir - ghclibDir <- installGhcLibDir - - -- Copy over packages - strip <- stripCmdPath - ways <- interpretInContext context getLibraryWays - -- TODO: Remove hard-coded @ghc-cabal@ path. - let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal" <.> exe - need [ghcCabalInplace] - - pkgConf <- pkgConfFile context - need [cabalFile, pkgConf] -- TODO: Check if we need 'pkgConf'. - - -- TODO: Drop redundant copies required by @ghc-cabal@. - -- See https://github.com/snowleopard/hadrian/issues/318. - quietly $ copyDirectoryContentsUntracked (Not excluded) - installDistDir (installDistDir -/- "build") - - pref <- setting InstallPrefix - unit $ cmd ghcCabalInplace [ "copy" - , pkgPath pkg - , absInstallDistDir - , strip - , destDir - , pref - , ghclibDir - , docDir -/- "html/libraries" - , unwords (map show ways) ] - - -- Register packages - let installedGhcPkgReal = destDir ++ binDir -/- "ghc-pkg" <.> exe - installedGhcReal = destDir ++ binDir -/- "ghc" <.> exe - -- TODO: Extend GhcPkg builder args to support --global-package-db - unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db" - , installedPackageConf, "update" - , confPath ] - - forM_ installLibPkgs $ \pkg -> - withInstallStage pkg $ \stage -> do - let context = vanillaContext stage pkg - top <- topDirectory - installDistDir <- (top -/-) <$> buildPath context - -- TODO: better reference to the built inplace binary path - let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal" - pref <- setting InstallPrefix - docDir <- installDocDir - r <- relocatableBuild - unit $ cmd ghcCabalInplace - [ "register" - , pkgPath pkg - , installDistDir - , installedGhcReal - , installedGhcPkgReal - , destDir ++ ghcLibDir - , destDir - , destDir ++ pref - , destDir ++ ghcLibDir - , destDir ++ docDir -/- "html/libraries" - , if r then "YES" else "NO" ] - - confs <- getDirectoryContents installedPackageConf - forM_ confs (\f -> createData $ installedPackageConf -/- f) - unit $ cmd installedGhcPkgReal [ "--force", "--global-package-db" - , installedPackageConf, "recache" ] - where - createData f = unit $ cmd "chmod" [ "644", f ] - excluded = Or [ Test "//haddock-prologue.txt" - , Test "//package-data.mk" - , Test "//setup-config" - , Test "//inplace-pkg-config" - , Test "//build" ] - --- ref: ghc.mk --- | Install settings etc. files to @prefix/lib@. -installCommonLibs :: Action () -installCommonLibs = do - ghcLibDir <- installGhcLibDir - destDir <- getDestDir - installLibsTo inplaceLibCopyTargets (destDir ++ ghcLibDir) - --- ref: ghc.mk --- | Install library files to some path. -installLibsTo :: [FilePath] -> FilePath -> Action () -installLibsTo libs dir = do - installDirectory dir - forM_ libs $ \lib -> case takeExtension lib of - ".a" -> do - let out = dir -/- takeFileName lib - installData [out] dir - runBuilder Ranlib [out] [out] [out] - _ -> installData [lib] dir - --- ref: includes/ghc.mk --- | All header files are in includes/{one of these subdirectories}. -includeHSubdirs :: [FilePath] -includeHSubdirs = [".", "rts", "rts/prof", "rts/storage", "stg"] - --- ref: includes/ghc.mk --- | Install header files to @prefix/lib/ghc-/include@. -installIncludes :: Action () -installIncludes = do - ghclibDir <- installGhcLibDir - destDir <- getDestDir - let ghcheaderDir = ghclibDir -/- "include" - installDirectory (destDir ++ ghcheaderDir) - forM_ includeHSubdirs $ \dir -> do - installDirectory (destDir ++ ghcheaderDir -/- dir) - headers <- getDirectoryFiles ("includes" -/- dir) ["*.h"] - installHeader (map (("includes" -/- dir) -/-) headers) - (destDir ++ ghcheaderDir -/- dir ++ "/") - root <- buildRoot - rtsPath <- rtsBuildPath - installHeader (fmap (root -/-) includesDependencies ++ - [root -/- generatedDir -/- "DerivedConstants.h"] ++ - fmap (rtsPath -/-) libffiDependencies) - (destDir ++ ghcheaderDir ++ "/") - where - installHeader = installData -- they share same arguments - --- ref: ghc.mk --- | Install documentation to @prefix/share/doc/ghc-@. -installDocs :: Action () -installDocs = do - destDir <- getDestDir - docDir <- installDocDir - root <- buildRoot - installDirectory (destDir ++ docDir) - - let usersGuide = root -/- "docs/pdfs/users_guide.pdf" - whenM (doesFileExist usersGuide) $ - installData [usersGuide] (destDir ++ docDir) - - let htmlDocDir = destDir ++ docDir -/- "html" - installDirectory htmlDocDir - installData ["docs/index.html"] htmlDocDir - - forM_ ["Haddock", "libraries", "users_guide"] $ \dirname -> do - let dir = root -/- "docs/html" -/- dirname - whenM (doesDirectoryExist dir) $ copyDirectory dir htmlDocDir --} diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs deleted file mode 100644 index 917f824bd6..0000000000 --- a/src/Rules/Wrappers.hs +++ /dev/null @@ -1,165 +0,0 @@ -module Rules.Wrappers ( - WrappedBinary(..), Wrapper, inplaceWrappers, installWrappers - ) where - -import Hadrian.Oracles.Path - -import Base -import Expression -import GHC (installStage) -import GHC.Packages -import Oracles.Setting -import Settings - --- | Wrapper is an expression depending on (i) the 'FilePath' to the library and --- (ii) the name of the wrapped binary. -data WrappedBinary = WrappedBinary - { binaryLibPath :: FilePath - , binaryName :: String } - -type Wrapper = WrappedBinary -> Expr String - -ghcWrapper :: WrappedBinary -> Expr String -ghcWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) - ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ] - -inplaceRunGhcWrapper :: WrappedBinary -> Expr String -inplaceRunGhcWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) - ++ " -f" ++ (binaryLibPath -/- "bin/ghc-stage2") -- TODO: use ProgramName - ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ] - -installRunGhcWrapper :: WrappedBinary -> Expr String -installRunGhcWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) - ++ " -f" ++ (binaryLibPath -/- "bin/ghc") -- TODO: use ProgramName - ++ " -B" ++ binaryLibPath ++ " ${1+\"$@\"}" ] - -inplaceGhcPkgWrapper :: WrappedBinary -> Expr String -inplaceGhcPkgWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - stage <- succ <$> getStage - -- The wrapper is generated in StageN, but used in StageN+1. Therefore, we - -- always use the inplace package database, located at 'inplacePackageDbPath', - -- which is used in Stage1 and later. - bash <- expr bashPath - path <- expr buildRoot - return $ unlines - [ "#!" ++ bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ - " --global-package-db " ++ path -/- relativePackageDbPath stage ++ " ${1+\"$@\"}" ] - -installGhcPkgWrapper :: WrappedBinary -> Expr String -installGhcPkgWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - stage <- getStage - top <- expr topDirectory - -- Use the package configuration for the next stage in the wrapper. - -- The wrapper is generated in StageN, but used in StageN+1. - packageDb <- expr $ installPackageDbPath binaryLibPath top (succ stage) - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) - ++ " --global-package-db " ++ packageDb ++ " ${1+\"$@\"}" ] - -hp2psWrapper :: WrappedBinary -> Expr String -hp2psWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ] - -hpcWrapper :: WrappedBinary -> Expr String -hpcWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ] - -hsc2hsWrapper :: WrappedBinary -> Expr String -hsc2hsWrapper WrappedBinary{..} = do - top <- expr topDirectory - expr $ need [ sourcePath -/- "Rules/Wrappers.hs" ] - contents <- expr $ readFile' $ top -/- "utils/hsc2hs/hsc2hs.wrapper" - let executableName = binaryLibPath -/- "bin" -/- binaryName - confCcArgs <- expr $ settingList (ConfCcArgs Stage1) - confGccLinkerArgs <- expr $ settingList (ConfGccLinkerArgs Stage1) - let hsc2hsExtra = unwords (map ("-cflags=" ++) confCcArgs) ++ " " ++ - unwords (map ("-lflags=" ++) confGccLinkerArgs) - bash <- expr bashPath - return $ unlines - [ "#!"++bash - , "executablename=\"" ++ executableName ++ "\"" - , "HSC2HS_EXTRA=\"" ++ hsc2hsExtra ++ "\"" - , contents ] - -haddockWrapper :: WrappedBinary -> Expr String -haddockWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - return $ unlines - [ "#!/bin/bash" - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) - ++ " -B" ++ binaryLibPath ++ " -l" ++ binaryLibPath ++ " ${1+\"$@\"}" ] - -iservBinWrapper :: WrappedBinary -> Expr String -iservBinWrapper WrappedBinary{..} = do - expr $ need [sourcePath -/- "Rules/Wrappers.hs"] - stage <- getStage - stageLibraries <- expr $ filter isLibrary <$> stagePackages stage - -- TODO: Figure our the reason of this hardcoded exclusion - let pkgs = stageLibraries \\ [ cabal, process, haskeline - , terminfo, ghcCompact, hpc, compiler ] - contexts <- expr $ concatForM pkgs $ \p -> do - maybeStage <- installStage p - return [ vanillaContext s p | s <- maybeToList maybeStage ] - buildPaths <- expr $ mapM buildPath contexts - return $ unlines - [ "#!/bin/bash" - , "export DYLD_LIBRARY_PATH=\"" ++ intercalate ":" buildPaths ++ - "${DYLD_LIBRARY_PATH:+:$DYLD_LIBRARY_PATH}\"" - , "exec " ++ (binaryLibPath -/- "bin" -/- binaryName) ++ " ${1+\"$@\"}" ] - -wrappersCommon :: [(Context, Wrapper)] -wrappersCommon = [ (vanillaContext Stage0 ghc , ghcWrapper) - , (vanillaContext Stage1 ghc , ghcWrapper) - , (vanillaContext Stage1 hp2ps , hp2psWrapper) - , (vanillaContext Stage1 hpc , hpcWrapper) - , (vanillaContext Stage1 hsc2hs, hsc2hsWrapper) - , (vanillaContext Stage2 haddock, haddockWrapper) - , (vanillaContext Stage1 iservBin, iservBinWrapper) ] - --- | List of wrappers for inplace artefacts -inplaceWrappers :: [(Context, Wrapper)] -inplaceWrappers = wrappersCommon ++ - [ (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper) - , (vanillaContext Stage1 runGhc, inplaceRunGhcWrapper) ] - --- | List of wrappers for installation -installWrappers :: [(Context, Wrapper)] -installWrappers = wrappersCommon ++ - [ (vanillaContext Stage0 ghcPkg, installGhcPkgWrapper) - , (vanillaContext Stage1 runGhc, installRunGhcWrapper) ] - --- | In the final installation path specified by @DEST@, there is another --- @package.conf.d@ different from 'inplacePackageDbPath' defined in "Base". -installPackageDbPath :: FilePath -> FilePath -> Stage -> Action FilePath -installPackageDbPath _ top Stage0 = do - path <- buildRoot - return $ top -/- path -/- "stage0/bootstrapping.conf" -installPackageDbPath libdir _ _ = return $ libdir -/- "package.conf.d" From 6df0c572b1e0b20bca9f254dd8a9e70b48f42ab0 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 28 Mar 2018 14:34:22 +0200 Subject: [PATCH 19/28] address more feedback --- cfg/system.config.in | 2 -- src/Builder.hs | 23 +++++++++++++++++++++-- src/Context.hs | 8 +------- src/GHC.hs | 2 -- src/GHC/Packages.hs | 3 +-- src/Oracles/Setting.hs | 4 ++-- src/Rules.hs | 13 +++++++++---- src/Rules/Dependencies.hs | 1 - src/Rules/Documentation.hs | 13 +++++++------ src/Rules/PackageData.hs | 7 +++---- src/Settings/Builders/HsCpp.hs | 2 +- 11 files changed, 45 insertions(+), 33 deletions(-) diff --git a/cfg/system.config.in b/cfg/system.config.in index 93002a2448..c983ae4a50 100644 --- a/cfg/system.config.in +++ b/cfg/system.config.in @@ -106,8 +106,6 @@ conf-ld-linker-args-stage0 = @CONF_LD_LINKER_OPTS_STAGE0@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ -conf-hs-cpp-args = @HaskellCPPArgs@ - # Include and library directories: #================================= diff --git a/src/Builder.hs b/src/Builder.hs index 3bbc92d38e..2ad0fffb8e 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -117,8 +117,27 @@ data Builder = Alex | Tar TarMode | Unlit | Xelatex - | CabalFlags Stage -- ^ a virtual builder to use the Arg predicate logic - -- to collect cabal flags. +x, -x + | CabalFlags Stage + -- ^ A \"virtual\" builder (not backed by a program), + -- used a lot in Settings.Packages, that allows us to + -- toggle cabal flags of packages depending on some `Args` + -- predicates, and then collect all those when we are about to + -- configure the said packages, in Hadrian.Haskell.Cabal.Parse, + -- so that we end up passing the appropriate flags to the Cabal + -- library. For example: + -- + -- > package rts + -- > ? builder CabalFlags + -- > ? any (wayUnit Profiling) rtsWays + -- > ? arg "profiling" + -- + -- (from Settings.Packages) specifies that if we're + -- processing the rts package with the `CabalFlag` builder, + -- and if we're building a profiling-enabled way of the rts, + -- then we pass the @profiling@ argument to the builder. This + -- argument is then collected by the code that performs the + -- package configuration, and @rts.cabal@ is processed as if + -- we were passing @-fprofiling@ to our build tool. deriving (Eq, Generic, Show) diff --git a/src/Context.hs b/src/Context.hs index b1cf2c6002..225752dc92 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -8,7 +8,7 @@ module Context ( -- * Paths contextDir, buildPath, buildDir, - pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile, + pkgInplaceConfig, pkgSetupConfigFile, pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile, pkgConfFile, objectPath, contextPath, getContextPath, libDir, libPath @@ -80,12 +80,6 @@ pkgInplaceConfig context = do path <- contextPath context return $ path -/- "inplace-pkg-config" --- | Path to the @package-data.mk@ of a given 'Context'. -pkgDataFile :: Context -> Action FilePath -pkgDataFile context = do - path <- contextPath context - return $ path -/- "package-data.mk" - -- | Path to the @setup-config@ of a given 'Context'. pkgSetupConfigFile :: Context -> Action FilePath pkgSetupConfigFile context = do diff --git a/src/GHC.hs b/src/GHC.hs index 7d7112e3c5..b22f3bb028 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -92,8 +92,6 @@ stage1Packages = do ++ [ haddock | not cross ] ++ [ runGhc | not cross ] ++ [ hpcBin | not cross ] - -- ++ [ libiserv | not win, not cross ] - -- TODO: ^^^ fix this ++ [ iservBin | not win, not cross ] ++ [ unix | not win ] ++ [ win32 | win ] diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 0c6d218b52..68c93ec52e 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -17,7 +17,7 @@ ghcPackages = , ghcTags, haddock, haskeline, hsc2hs, hp2ps, 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 --, libiserv + , transformers, unlit, unix, win32, xhtml ] -- TODO: Optimise by switching to sets of packages. @@ -78,7 +78,6 @@ unlit = hsUtil "unlit" unix = hsLib "unix" win32 = hsLib "Win32" xhtml = hsLib "xhtml" --- libiserv = hsLib "libiserv" -- | Construct a Haskell library package, e.g. @array@. diff --git a/src/Oracles/Setting.hs b/src/Oracles/Setting.hs index cc57730f12..aa49011e1e 100644 --- a/src/Oracles/Setting.hs +++ b/src/Oracles/Setting.hs @@ -72,7 +72,7 @@ data SettingList = ConfCcArgs Stage | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage - | ConfHsCppArgs + | HsCppArgs -- | Maps 'Setting's to names in @cfg/system.config.in@. setting :: Setting -> Action String @@ -130,7 +130,7 @@ settingList key = fmap words $ lookupValueOrError configFile $ case key of ConfCppArgs stage -> "conf-cpp-args-" ++ stageString stage ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage - ConfHsCppArgs -> "conf-hs-cpp-args" + HsCppArgs -> "hs-cpp-args" -- | Get a configuration setting. getSetting :: Setting -> Expr c b String diff --git a/src/Rules.hs b/src/Rules.hs index 017f33f298..46b69e7ff8 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -31,16 +31,21 @@ allStages = [minBound .. maxBound] topLevelTargets :: Rules () topLevelTargets = do phony "stage2" $ do - putNormal "Building stage2" (programs, libraries) <- partition isProgram <$> stagePackages Stage1 pgmNames <- mapM (g Stage1) programs libNames <- mapM (g Stage1) libraries - putNormal . unlines $ - ["| Building Programs: " ++ intercalate ", " pgmNames - ,"| Building Libraries: " ++ intercalate ", " libNames] + + verbosity <- getVerbosity + when (verbosity >= Loud) $ do + putNormal "Building stage2" + putNormal . unlines $ + [ "| Building Programs: " ++ intercalate ", " pgmNames + , "| Building Libraries: " ++ intercalate ", " libNames + ] targets <- mapM (f Stage1) =<< stagePackages Stage1 need targets + where -- either the package database config file for libraries or -- the programPath for programs. However this still does diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs index d8e66f7c4f..9589d12aa0 100644 --- a/src/Rules/Dependencies.hs +++ b/src/Rules/Dependencies.hs @@ -25,7 +25,6 @@ buildPackageDependencies rs context@Context {..} = do removeFile $ mk <.> "bak" root -/- contextDir context -/- ".dependencies" %> \deps -> do - need [deps <.> "mk"] mkDeps <- readFile' (deps <.> "mk") writeFileChanged deps . unlines . map (\(src, deps) -> unwords $ src : deps) diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index f3b0d2aa4c..9f2b0ea3d1 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -34,12 +34,13 @@ documentationRules = do archives = map pathArchive docPaths pdfs = map pathPdf $ docPaths \\ [ "libraries" ] need $ map (root -/-) $ [html] ++ archives ++ pdfs - need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" ] - need [ root -/- htmlRoot -/- "libraries" -/- "prologue.txt" ] - need [ root -/- manPagePath ] + need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" + , root -/- htmlRoot -/- "libraries" -/- "prologue.txt" + , root -/- manPageBuildPath + ] -manPagePath :: FilePath -manPagePath = "docs/users_guide/build-man/ghc.1" +manPageBuildPath :: FilePath +manPageBuildPath = "docs/users_guide/build-man/ghc.1" -- TODO: Add support for Documentation Packages so we can -- run the builders without this hack. @@ -211,7 +212,7 @@ buildArchive path = do buildManPage :: Rules () buildManPage = do root <- buildRootRules - root -/- manPagePath %> \file -> do + root -/- manPageBuildPath %> \file -> do need ["docs/users_guide/ghc.rst"] let context = vanillaContext Stage1 docPackage withTempDir $ \dir -> do diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 3229f8eeba..96e996032e 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -10,17 +10,16 @@ import Utilities import Hadrian.Haskell.Cabal.Parse (configurePackage) --- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files. +-- | 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 - -- TODO: Get rid of hardcoded file paths. dir -/- "setup-config" %> \_ -> configurePackage context dir -/- "inplace-pkg-config" %> \conf -> do - dataFile <- pkgDataFile context - need [dataFile] when (package == rts) $ do genPath <- buildRoot <&> (-/- generatedDir) rtsPath <- rtsBuildPath diff --git a/src/Settings/Builders/HsCpp.hs b/src/Settings/Builders/HsCpp.hs index 78e4aabfb8..54b6faf4f0 100644 --- a/src/Settings/Builders/HsCpp.hs +++ b/src/Settings/Builders/HsCpp.hs @@ -8,7 +8,7 @@ hsCppBuilderArgs = builder HsCpp ? do stage <- getStage root <- getBuildRoot ghcPath <- expr $ buildPath (vanillaContext stage compiler) - mconcat [ getSettingList ConfHsCppArgs + mconcat [ getSettingList HsCppArgs , arg "-P" , arg "-Iincludes" , arg $ "-I" ++ root -/- generatedDir From 65de6012c1f76a6850bc84c9f856e2ab97328e10 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 28 Mar 2018 17:24:37 +0200 Subject: [PATCH 20/28] ConfiguredCabal -> PackageData, more comments, more feedback addressed --- hadrian.cabal | 2 +- src/Builder.hs | 17 ++++----- src/Builder.hs-boot | 3 -- src/Context/Paths.hs | 2 +- src/Expression.hs | 12 +++--- src/Hadrian/Haskell/Cabal.hs | 9 +++-- .../Cabal/{Configured.hs => PackageData.hs} | 13 +++---- src/Hadrian/Haskell/Cabal/Parse.hs | 37 ++++++++++++++----- src/Hadrian/Haskell/Cabal/Parse.hs-boot | 4 +- src/Hadrian/Oracles/TextFile.hs | 18 ++++----- src/Hadrian/Package.hs | 4 ++ src/Oracles/ModuleFiles.hs | 10 ++--- src/Rules/Documentation.hs | 10 ++--- src/Rules/Library.hs | 6 +-- src/Rules/Program.hs | 4 +- src/Settings/Builders/Cc.hs | 4 +- src/Settings/Builders/Common.hs | 6 +-- src/Settings/Builders/Ghc.hs | 12 +++--- src/Settings/Builders/Haddock.hs | 6 +-- src/Settings/Builders/Hsc2Hs.hs | 14 +++---- src/Settings/Default.hs | 4 +- src/Utilities.hs | 6 +-- 22 files changed, 110 insertions(+), 93 deletions(-) rename src/Hadrian/Haskell/Cabal/{Configured.hs => PackageData.hs} (79%) diff --git a/hadrian.cabal b/hadrian.cabal index 61a4b8d230..486148fc72 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -36,7 +36,7 @@ executable hadrian , Hadrian.Builder.Tar , Hadrian.Expression , Hadrian.Haskell.Cabal - , Hadrian.Haskell.Cabal.Configured + , Hadrian.Haskell.Cabal.PackageData , Hadrian.Haskell.Cabal.Parse , Hadrian.Haskell.Cabal.Type , Hadrian.Oracles.ArgsHash diff --git a/src/Builder.hs b/src/Builder.hs index 2ad0fffb8e..8ce2aeae5c 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -4,8 +4,6 @@ module Builder ( ArMode (..), CcMode (..), GhcCabalMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..), SphinxMode (..), TarMode (..), Builder (..), - builderPath', - -- * Builder properties builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, @@ -55,7 +53,7 @@ instance Binary GhcMode instance Hashable GhcMode instance NFData GhcMode --- | GHC cabal mode. Can configure, copy and register pacakges. +-- | GHC cabal mode. Can configure, copy and register packages. data GhcCabalMode = Conf | HsColour | Check | Sdist deriving (Eq, Generic, Show) @@ -167,9 +165,6 @@ builderProvenance = \case where context s p = Just $ vanillaContext s p -builderPath' :: Builder -> Action FilePath -builderPath' = builderPath - instance H.Builder Builder where builderPath :: Builder -> Action FilePath builderPath builder = case builderProvenance builder of @@ -199,7 +194,7 @@ instance H.Builder Builder where -- query the builder for some information. -- contrast this with runBuilderWith, which returns @Action ()@ -- this returns the @stdout@ from running the builder. - -- For now this only implements asking @ghc-pkg@ about pacakge + -- For now this only implements asking @ghc-pkg@ about package -- dependencies. askBuilderWith :: Builder -> BuildInfo -> Action String askBuilderWith builder BuildInfo {..} = case builder of @@ -262,8 +257,12 @@ instance H.Builder Builder where unit $ cmd [Cwd output] [path] buildArgs GhcPkg Clone _ -> do - -- input is "virtual" here. it's essentially a package name - Stdout pkgDesc <- cmd [path] ["--expand-pkgroot", "--no-user-package-db", "describe", input ] + Stdout pkgDesc <- cmd [path] + [ "--expand-pkgroot" + , "--no-user-package-db" + , "describe" + , input -- the package name + ] cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"]) _ -> cmd echo [path] buildArgs diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index 7ae43e07e3..e8eed47ef4 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -4,7 +4,6 @@ import Stage import Hadrian.Builder.Ar import Hadrian.Builder.Sphinx import Hadrian.Builder.Tar -import Development.Shake data CcMode = CompileC | FindCDependencies data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs @@ -45,5 +44,3 @@ data Builder = Alex instance Eq Builder instance Show Builder - -builderPath' :: Builder -> Action FilePath diff --git a/src/Context/Paths.hs b/src/Context/Paths.hs index 32ccf45cd4..b023c4d3b5 100644 --- a/src/Context/Paths.hs +++ b/src/Context/Paths.hs @@ -32,7 +32,7 @@ buildDir context = contextDir context -/- "build" -- | Path to the directory containing build artifacts of a given 'Context'. buildPath :: Context -> Action FilePath -buildPath context = buildRoot <&> (-/- (buildDir context)) +buildPath context = buildRoot <&> (-/- buildDir context) -- | Get the build path of the current 'Context'. getBuildPath :: Expr Context b FilePath diff --git a/src/Expression.hs b/src/Expression.hs index 8fe0f992b7..3a26f43148 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -14,7 +14,7 @@ module Expression ( -- * Convenient accessors getBuildRoot, getContext, getOutputs, getInputs, - getInput, getOutput, getConfiguredCabalData, + getInput, getOutput, getPackageData, -- * Re-exports module Base, @@ -27,14 +27,14 @@ import {-# SOURCE #-} Builder import Context hiding (stage, package, way) import Expression.Type import Hadrian.Expression hiding (Expr, Predicate, Args) -import Hadrian.Haskell.Cabal.Configured (ConfiguredCabal) -import Hadrian.Oracles.TextFile (readConfiguredCabalFile) +import Hadrian.Haskell.Cabal.PackageData (PackageData) +import Hadrian.Oracles.TextFile (readPackageDataFile) -- | Get values from a configured cabal stage. -getConfiguredCabalData :: (ConfiguredCabal -> a) -> Expr a -getConfiguredCabalData key = do +getPackageData :: (PackageData -> a) -> Expr a +getPackageData key = do ctx <- getContext - Just cabal <- expr (readConfiguredCabalFile ctx) + Just cabal <- expr (readPackageDataFile ctx) return $ key cabal -- | Is the build currently in the provided stage? diff --git a/src/Hadrian/Haskell/Cabal.hs b/src/Hadrian/Haskell/Cabal.hs index 2baee600e6..faba64f6e7 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -13,11 +13,12 @@ module Hadrian.Haskell.Cabal ( pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis ) where +import Data.Maybe import Development.Shake import Context.Type -import Hadrian.Haskell.Cabal.Type as C -import Hadrian.Haskell.Cabal.Configured as CC +import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal.PackageData as PD import Hadrian.Package import Hadrian.Oracles.TextFile @@ -29,7 +30,7 @@ pkgVersion = fmap (fmap C.version) . readCabalFile -- The Cabal file is tracked. pkgIdentifier :: Context -> Action String pkgIdentifier ctx = do - Just cabal <- readCabalFile ctx + cabal <- fromMaybe (error "Cabal file could not be read") <$> readCabalFile ctx return $ if null (C.version cabal) then C.name cabal else C.name cabal ++ "-" ++ C.version cabal @@ -39,7 +40,7 @@ pkgIdentifier ctx = do -- returns a crude overapproximation of actual dependencies. The Cabal file is -- tracked. pkgDependencies :: Context -> Action (Maybe [PackageName]) -pkgDependencies = fmap (fmap CC.dependencies) . readConfiguredCabalFile +pkgDependencies = fmap (fmap PD.dependencies) . readPackageDataFile -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Context -> Action (Maybe String) diff --git a/src/Hadrian/Haskell/Cabal/Configured.hs b/src/Hadrian/Haskell/Cabal/PackageData.hs similarity index 79% rename from src/Hadrian/Haskell/Cabal/Configured.hs rename to src/Hadrian/Haskell/Cabal/PackageData.hs index 90d60ba3b4..9bbebcf9d8 100644 --- a/src/Hadrian/Haskell/Cabal/Configured.hs +++ b/src/Hadrian/Haskell/Cabal/PackageData.hs @@ -1,14 +1,13 @@ -module Hadrian.Haskell.Cabal.Configured where +module Hadrian.Haskell.Cabal.PackageData where import Development.Shake.Classes import Hadrian.Package.Type import GHC.Generics -data ConfiguredCabal = ConfiguredCabal +data PackageData = PackageData { dependencies :: [PackageName] , name :: PackageName , version :: String - -- , packageDesc :: C.PackageDescription -- * used to be pkg Data , componentId :: String , modules :: [String] @@ -22,7 +21,7 @@ data ConfiguredCabal = ConfiguredCabal , depCompIds :: [String] , includeDirs :: [String] , includes :: [String] - , installIncludes :: [String] -- TODO: do we need this one? + , installIncludes :: [String] , extraLibs :: [String] , extraLibDirs :: [String] , asmSrcs :: [String] @@ -41,7 +40,7 @@ data ConfiguredCabal = ConfiguredCabal , buildGhciLib :: Bool } deriving (Eq, Read, Show, Typeable, Generic) -instance Binary ConfiguredCabal +instance Binary PackageData -instance Hashable ConfiguredCabal -instance NFData ConfiguredCabal +instance Hashable PackageData +instance NFData PackageData diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index f899ba1896..e3c675baa3 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -9,7 +9,7 @@ -- Extracting Haskell package metadata stored in Cabal files. ----------------------------------------------------------------------------- module Hadrian.Haskell.Cabal.Parse - ( ConfiguredCabal (..), parseCabal, parseConfiguredCabal + ( PackageData (..), parseCabal, parsePackageData , parseCabalPkgId , configurePackage, copyPackage, registerPackage ) where @@ -42,17 +42,19 @@ import qualified Distribution.Verbosity as C import Base import Builder hiding (Builder) -import Context -- .Type +import Context import Flavour (args) import GHC.Packages (rts) import Hadrian.Expression +import Hadrian.Haskell.Cabal.PackageData import Hadrian.Haskell.Cabal.Type ( Cabal( Cabal ) ) -import Hadrian.Haskell.Cabal.Configured import Hadrian.Oracles.TextFile import Hadrian.Target import Settings import Oracles.Setting +-- | Parse the Cabal package identifier from the .cabal file at the given +-- filepath. parseCabalPkgId :: FilePath -> IO String parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file @@ -75,6 +77,12 @@ biModules pd = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.li go _ = error "can not handle more than one buildinfo yet!" isHaskell fp = takeExtension fp `elem` [".hs", ".lhs"] +-- | Parse the cabal file of the package from the given 'Context'. +-- +-- This function reads the cabal file, gets some information about the compiler +-- to be used corresponding to the stage it gets from the 'Context', and finalizes +-- the package description it got from the cabal file with the additional information +-- it got (e.g platform, compiler version conditionals, package flags). parseCabal :: Context -> Action Cabal parseCabal context@Context {..} = do let (Just file) = pkgCabalFile package @@ -83,7 +91,7 @@ parseCabal context@Context {..} = do gpd <- liftIO $ C.readGenericPackageDescription C.verbose file -- configure the package with the ghc compiler for this stage. - hcPath <- builderPath' (Ghc CompileHs stage) + hcPath <- builderPath (Ghc CompileHs stage) (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb @@ -109,6 +117,12 @@ parseCabal context@Context {..} = do pd depPkgs +-- | This function runs the equivalent of @cabal configure@ using the Cabal library +-- directly, collecting all the configuration options and flags to be passed to Cabal +-- before invoking it. +-- +-- It of course also 'need's package database entries for the dependencies of +-- the package the 'Context' points to. configurePackage :: Context -> Action () configurePackage context@Context {..} = do Just (Cabal _ _ _ gpd _pd depPkgs) <- readCabalFile context @@ -148,7 +162,9 @@ configurePackage context@Context {..} = do liftIO $ do Hooks.defaultMainWithHooksNoReadArgs hooks gpd (argList ++ ["--flags=" ++ unwords flagList]) --- XXX: move this somewhere else. This is logic from ghc-cabal +-- | Copies a built package (that the 'Context' points to) into a package +-- database (the one for the ghc corresponding to the stage the 'Context' +-- points to). copyPackage :: Context -> Action () copyPackage context@Context {..} = do -- original invocation @@ -164,6 +180,8 @@ copyPackage context@Context {..} = do liftIO $ Hooks.defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath] +-- | Registers a built package (the one the 'Context' points to) +-- into the package database. registerPackage :: Context -> Action () registerPackage context@Context {..} = do top <- topDirectory @@ -175,9 +193,9 @@ registerPackage context@Context {..} = do liftIO $ Hooks.defaultMainWithHooksNoReadArgs regHooks gpd ["register", "--builddir", ctxPath] --- | Parse a ConfiguredCabal file. -parseConfiguredCabal :: Context -> Action ConfiguredCabal -parseConfiguredCabal context@Context {..} = do +-- | Parses the 'PackageData' for a package (the one in the 'Context'). +parsePackageData :: Context -> Action PackageData +parsePackageData context@Context {..} = do -- XXX: This is conceptually wrong! -- We should use the gpd, and -- the flagAssignment and compiler, hostPlatform, ... information @@ -240,11 +258,10 @@ parseConfiguredCabal context@Context {..} = do -- the RTS's library-dirs here. _ -> error "No (or multiple) ghc rts package is registered!!" - in return $ ConfiguredCabal + in return $ PackageData { dependencies = deps , name = C.unPackageName . C.pkgName . C.package $ pd' , version = C.display . C.pkgVersion . C.package $ pd' - -- , packageDesc = pd , componentId = C.localCompatPackageKey lbi' , modules = map C.display . snd . biModules $ pd' , otherModules = map C.display . C.otherModules . fst . biModules $ pd' diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs-boot b/src/Hadrian/Haskell/Cabal/Parse.hs-boot index d9c7f97b8c..6517c8df09 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs-boot +++ b/src/Hadrian/Haskell/Cabal/Parse.hs-boot @@ -2,8 +2,8 @@ module Hadrian.Haskell.Cabal.Parse where import Context.Type (Context) import Development.Shake (Action) +import Hadrian.Haskell.Cabal.PackageData (PackageData) import Hadrian.Haskell.Cabal.Type (Cabal) -import Hadrian.Haskell.Cabal.Configured (ConfiguredCabal) parseCabal :: Context -> Action Cabal -parseConfiguredCabal :: Context -> Action ConfiguredCabal +parsePackageData :: Context -> Action PackageData diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index 57d8c94a80..400171e48d 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -13,7 +13,7 @@ module Hadrian.Oracles.TextFile ( readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, - readCabalFile, readConfiguredCabalFile, textFileOracle + readCabalFile, readPackageDataFile, textFileOracle ) where import Control.Monad @@ -24,8 +24,8 @@ import Development.Shake.Classes import Development.Shake.Config import Context.Type +import Hadrian.Haskell.Cabal.PackageData import Hadrian.Haskell.Cabal.Type -import Hadrian.Haskell.Cabal.Configured import {-# SOURCE #-} Hadrian.Haskell.Cabal.Parse import Hadrian.Package import Hadrian.Utilities @@ -39,9 +39,9 @@ newtype CabalFile = CabalFile Context deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult CabalFile = Maybe Cabal -newtype ConfiguredCabalFile = ConfiguredCabalFile Context +newtype PackageDataFile = PackageDataFile Context deriving (Binary, Eq, Hashable, NFData, Show, Typeable) -type instance RuleResult ConfiguredCabalFile = Maybe ConfiguredCabal +type instance RuleResult PackageDataFile = Maybe PackageData newtype KeyValue = KeyValue (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -102,8 +102,8 @@ lookupDependencies depFile file = do readCabalFile :: Context -> Action (Maybe Cabal) readCabalFile = askOracle . CabalFile -readConfiguredCabalFile :: Context -> Action (Maybe ConfiguredCabal) -readConfiguredCabalFile = askOracle . ConfiguredCabalFile +readPackageDataFile :: Context -> Action (Maybe PackageData) +readPackageDataFile = askOracle . PackageDataFile -- | This oracle reads and parses text files to answer 'readTextFile' and -- 'lookupValue' queries, as well as their derivatives, tracking the results. @@ -142,8 +142,8 @@ textFileOracle = do case pkgCabalFile package of Just file -> do need [file] - putLoud $ "| ConfiguredCabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..." - Just <$> parseConfiguredCabal ctx + putLoud $ "| PackageDataFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..." + Just <$> parsePackageData ctx Nothing -> return Nothing - void $ addOracle $ \(ConfiguredCabalFile ctx) -> confCabal ctx + void $ addOracle $ \(PackageDataFile ctx) -> confCabal ctx diff --git a/src/Hadrian/Package.hs b/src/Hadrian/Package.hs index 8b5a957b10..ee9e4e21f6 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -63,6 +63,10 @@ isCPackage _ = False -- | Is this a Haskell package? isHsPackage :: Package -> Bool isHsPackage (Package Haskell _ _ _) = True +-- we consider the RTS as a haskell package because we +-- use information from its Cabal file to build it, +-- and we e.g want 'pkgCabalFile' to point us to +-- 'rts/rts.cabal' when passed the rts package as argument. isHsPackage (Package _ _ "rts" _) = True isHsPackage _ = False diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index cbf8a69397..fc3d72e754 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -10,7 +10,7 @@ import Builder import Context import Expression import GHC -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD newtype ModuleFiles = ModuleFiles (Stage, Package) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -89,7 +89,7 @@ hsSources context = do -- the build directory regardless of whether they are generated or not. hsObjects :: Context -> Action [FilePath] hsObjects context = do - modules <- interpretInContext context (getConfiguredCabalData ConfCabal.modules) + modules <- interpretInContext context (getPackageData PD.modules) mapM (objectPath context . moduleSource) modules -- | Generated module files live in the 'Context' specific build directory. @@ -105,7 +105,7 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" contextFiles :: Context -> Action [(String, Maybe FilePath)] contextFiles context@Context {..} = do modules <- fmap sort . interpretInContext context $ - getConfiguredCabalData ConfCabal.modules + getPackageData PD.modules zip modules <$> askOracle (ModuleFiles (stage, package)) -- | This is an important oracle whose role is to find and cache module source @@ -123,8 +123,8 @@ moduleFilesOracle :: Rules () moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package - srcDirs <- interpretInContext context (getConfiguredCabalData ConfCabal.srcDirs) - modules <- fmap sort $ interpretInContext context (getConfiguredCabalData ConfCabal.modules) + srcDirs <- interpretInContext context (getPackageData PD.srcDirs) + modules <- fmap sort $ interpretInContext context (getPackageData PD.modules) autogen <- autogenPath context let dirs = autogen : map (pkgPath package -/-) srcDirs modDirFiles = groupSort $ map decodeModule modules diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 9f2b0ea3d1..6523a2bba4 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -8,7 +8,7 @@ module Rules.Documentation ( import Base import Context -import Expression (getConfiguredCabalData, interpretInContext) +import Expression (getPackageData, interpretInContext) import Flavour import GHC import Oracles.ModuleFiles @@ -16,7 +16,7 @@ import Settings import Target import Utilities -import qualified Hadrian.Haskell.Cabal.Configured as ConfCabal +import qualified Hadrian.Haskell.Cabal.PackageData as PD -- | Build all documentation documentationRules :: Rules () @@ -139,7 +139,7 @@ haddockHtmlLib = "docs/html/haddock-bundle.min.js" -- | Find the haddock files for the dependencies of the current library haddockDependencies :: Context -> Action [FilePath] haddockDependencies context = do - depNames <- interpretInContext context (getConfiguredCabalData ConfCabal.depNames) + depNames <- interpretInContext context (getPackageData PD.depNames) sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] @@ -153,8 +153,8 @@ buildPackageDocumentation context@Context {..} = when (stage == Stage1 && packag -- Per-package haddocks root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" %> \file -> do -- this is how ghc-cabal produces "haddock-prologue.txt" files - (syn, desc) <- interpretInContext context . getConfiguredCabalData $ \p -> - (ConfCabal.synopsis p, ConfCabal.description p) + (syn, desc) <- interpretInContext context . getPackageData $ \p -> + (PD.synopsis p, PD.description p) let prologue = if null desc then syn else desc diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 901631f50f..e9f8ff69be 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -3,7 +3,7 @@ module Rules.Library ( ) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId) import Base @@ -122,14 +122,14 @@ allObjects context = (++) <$> nonHsObjects context <*> hsObjects context nonHsObjects :: Context -> Action [FilePath] nonHsObjects context = do cObjs <- cObjects context - cmmSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cmmSrcs) + cmmSrcs <- interpretInContext context (getPackageData PD.cmmSrcs) cmmObjs <- mapM (objectPath context) cmmSrcs eObjs <- extraObjects context return $ cObjs ++ cmmObjs ++ eObjs cObjects :: Context -> Action [FilePath] cObjects context = do - srcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) + srcs <- interpretInContext context (getPackageData PD.cSrcs) objs <- mapM (objectPath context) srcs return $ if way context == threaded then objs diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 4b65d7c25e..32a8eb8dcc 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -1,7 +1,7 @@ module Rules.Program (buildProgram) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Base import Context @@ -64,7 +64,7 @@ buildBinary rs bin context@Context {..} = do when (stage > Stage0) $ do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ rtsContext { way = w } | w <- ways ] - cSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) + cSrcs <- interpretInContext context (getPackageData PD.cSrcs) cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index 15644b9c10..c78a19da8f 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -1,13 +1,13 @@ module Settings.Builders.Cc (ccBuilderArgs) where -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Settings.Builders.Common ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay builder Cc ? mconcat - [ getConfiguredCabalData ConfCabal.ccOpts + [ getPackageData PD.ccOpts , getStagedSettingList ConfCcArgs , builder (Cc CompileC) ? mconcat diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 4c43fcb99a..40e5d707fd 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -12,7 +12,7 @@ module Settings.Builders.Common ( import Base import Expression import GHC.Packages -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Oracles.Flag import Oracles.Setting import Settings @@ -23,8 +23,8 @@ cIncludeArgs = do pkg <- getPackage root <- getBuildRoot path <- getBuildPath - incDirs <- getConfiguredCabalData ConfCabal.includeDirs - depDirs <- getConfiguredCabalData ConfCabal.depIncludeDirs + incDirs <- getPackageData PD.includeDirs + depDirs <- getPackageData PD.depIncludeDirs iconvIncludeDir <- getSetting IconvIncludeDir gmpIncludeDir <- getSetting GmpIncludeDir ffiIncludeDir <- getSetting FfiIncludeDir diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index cfb18e3eb4..a018360748 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -6,7 +6,7 @@ import Settings.Builders.Common import Settings.Warnings import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] @@ -25,7 +25,7 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do compileC :: Args compileC = builder (Ghc CompileCWithGhc) ? do way <- getWay - let ccArgs = [ getConfiguredCabalData ConfCabal.ccOpts + let ccArgs = [ getPackageData PD.ccOpts , getStagedSettingList ConfCcArgs , cIncludeArgs , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ] @@ -65,7 +65,7 @@ findHsDependencies = builder (Ghc FindHsDependencies) ? do , getInputs ] haddockGhcArgs :: Args -haddockGhcArgs = mconcat [ commonGhcArgs, getConfiguredCabalData ConfCabal.hcOpts ] +haddockGhcArgs = mconcat [ commonGhcArgs, getPackageData PD.hcOpts ] -- Used in ghcBuilderArgs, ghcCBuilderArgs, ghcMBuilderArgs and haddockGhcArgs. commonGhcArgs :: Args @@ -90,7 +90,7 @@ commonGhcArgs = do , (pkg == rts) ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion) , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs - , map ("-optP" ++) <$> getConfiguredCabalData ConfCabal.cppOpts + , map ("-optP" ++) <$> getPackageData PD.cppOpts , arg "-odir" , arg path , arg "-hidir" , arg path , arg "-stubdir" , arg path ] @@ -116,7 +116,7 @@ packageGhcArgs = withHsPackage $ \ctx -> do , arg "-no-user-package-db" , packageDatabaseArgs , libraryPackage ? arg ("-this-unit-id " ++ pkgId) - , map ("-package-id " ++) <$> getConfiguredCabalData ConfCabal.depIpIds ] + , map ("-package-id " ++) <$> getPackageData PD.depIpIds ] includeGhcArgs :: Args includeGhcArgs = do @@ -124,7 +124,7 @@ includeGhcArgs = do path <- getBuildPath root <- getBuildRoot context <- getContext - srcDirs <- getConfiguredCabalData ConfCabal.srcDirs + srcDirs <- getPackageData PD.srcDirs autogen <- expr $ autogenPath context mconcat [ arg "-i" , arg $ "-i" ++ path diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index 59708587d6..248656939b 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -1,7 +1,7 @@ module Settings.Builders.Haddock (haddockBuilderArgs) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Hadrian.Utilities import Rules.Documentation import Settings.Builders.Common @@ -36,7 +36,7 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat path <- getBuildPath Just version <- expr $ pkgVersion ctx Just synopsis <- expr $ pkgSynopsis ctx - deps <- getConfiguredCabalData ConfCabal.depNames + deps <- getPackageData PD.depNames haddocks <- expr . haddockDependencies =<< getContext Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs @@ -56,7 +56,7 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt" , arg $ "--optghc=-D__HADDOCK_VERSION__=" ++ show (versionToInt hVersion) - , map ("--hide=" ++) <$> getConfiguredCabalData ConfCabal.otherModules + , map ("--hide=" ++) <$> getPackageData PD.otherModules , pure [ "--read-interface=../" ++ dep ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME}," ++ haddock | (dep, haddock) <- zip deps haddocks ] diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 563011a7a9..3a8094089a 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -3,7 +3,7 @@ module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where import Builder () import GHC (autogenPath) import Hadrian.Builder (getBuilderPath) -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Settings.Builders.Common hsc2hsBuilderArgs :: Args @@ -43,10 +43,10 @@ getCFlags = do mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) , getStagedSettingList ConfCppArgs , cIncludeArgs - , getConfiguredCabalData ConfCabal.ccOpts - -- XXX: is cppOpts correct here? - , getConfiguredCabalData ConfCabal.cppOpts - , getConfiguredCabalData ConfCabal.depCcOpts + , getPackageData PD.ccOpts + -- we might be able to leave out cppOpts, to be investigated. + , getPackageData PD.cppOpts + , getPackageData PD.depCcOpts , cWarnings , arg "-include", arg $ autogen -/- "cabal_macros.h" ] @@ -54,5 +54,5 @@ getLFlags :: Expr [String] getLFlags = mconcat [ getStagedSettingList ConfGccLinkerArgs , ldArgs - , getConfiguredCabalData ConfCabal.ldOpts - , getConfiguredCabalData ConfCabal.depLdOpts ] + , getPackageData PD.ldOpts + , getPackageData PD.depLdOpts ] diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 988e847272..5ef0cc3e04 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -35,7 +35,7 @@ import GHC.Packages import qualified Hadrian.Builder.Ar import qualified Hadrian.Builder.Sphinx import qualified Hadrian.Builder.Tar -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD -- TODO: Move C source arguments here -- | Default and package-specific source arguments. @@ -49,7 +49,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault - , getConfiguredCabalData ConfCabal.hcOpts + , getPackageData PD.hcOpts , libraryPackage ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] diff --git a/src/Utilities.hs b/src/Utilities.hs index d178a9deac..279db9e180 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -8,7 +8,7 @@ module Utilities ( import qualified Hadrian.Builder as H import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Hadrian.Haskell.Cabal.PackageData as PD import Hadrian.Utilities import Context @@ -55,7 +55,7 @@ contextDependencies ctx@Context {..} = do cabalDependencies :: Context -> Action [String] cabalDependencies ctx = interpretInContext ctx $ - getConfiguredCabalData ConfCabal.depIpIds + getPackageData PD.depIpIds -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context. stage1Dependencies :: Package -> Action [Package] @@ -71,7 +71,7 @@ libraryTargets includeGhciLib context = do lib0 <- buildDll0 context ghciLib <- pkgGhciLibraryFile context ghci <- if includeGhciLib - then interpretInContext context $ getConfiguredCabalData ConfCabal.buildGhciLib + then interpretInContext context $ getPackageData PD.buildGhciLib else return False return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ] From cb4fbc717a525c2590ca84242e052a801b27def0 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 28 Mar 2018 17:28:22 +0200 Subject: [PATCH 21/28] make the complete stage 2 build the default --- src/Rules.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 46b69e7ff8..9e38e98ec7 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -29,8 +29,7 @@ allStages = [minBound .. maxBound] -- | This rule calls 'need' on all top-level build targets, respecting the -- 'Stage1Only' flag. topLevelTargets :: Rules () -topLevelTargets = do - phony "stage2" $ do +topLevelTargets = action $ do (programs, libraries) <- partition isProgram <$> stagePackages Stage1 pgmNames <- mapM (g Stage1) programs libNames <- mapM (g Stage1) libraries From 78187015a2455151405088bc3c7d241977fb5842 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 28 Mar 2018 17:40:29 +0200 Subject: [PATCH 22/28] use a dummy package instead of base in Rules.hs --- src/Hadrian/Package.hs | 9 ++++++++- src/Rules.hs | 4 ++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Hadrian/Package.hs b/src/Hadrian/Package.hs index ee9e4e21f6..698326bfdc 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -16,7 +16,7 @@ module Hadrian.Package ( Package (..), PackageName, PackageLanguage, PackageType, -- * Construction and properties - cLibrary, cProgram, hsLibrary, hsProgram, + cLibrary, cProgram, hsLibrary, hsProgram, dummyPackage, isLibrary, isProgram, isCPackage, isHsPackage, -- * Package directory structure @@ -45,6 +45,13 @@ hsLibrary = Package Haskell Library hsProgram :: PackageName -> FilePath -> Package hsProgram = Package Haskell Program +-- | A dummy package, which we never try to build +-- but just use as a better @undefined@ in code +-- where we need a 'Package' to set up a Context +-- but will not really operate over one. +dummyPackage :: Package +dummyPackage = hsLibrary "dummy" "dummy/path/" + -- | Is this a library package? isLibrary :: Package -> Bool isLibrary (Package _ Library _ _) = True diff --git a/src/Rules.hs b/src/Rules.hs index 9e38e98ec7..982d24969a 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -108,10 +108,10 @@ packageRules = do forM_ [Stage0 .. ] $ \stage -> do -- we create a dummy context, that has the correct state, but contains - -- @base@ 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 -- being forced. - Rules.Register.registerPackages writePackageDb (Context stage base vanilla) + Rules.Register.registerPackages writePackageDb (Context stage dummyPackage vanilla) forM_ vanillaContexts $ mconcat [ Rules.PackageData.buildPackageData From a736fde897875115e6c9c4f42f84b5333c9cf58c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 28 Mar 2018 19:28:56 +0200 Subject: [PATCH 23/28] update CI scripts --- .travis.yml | 6 +++--- appveyor.yml | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/.travis.yml b/.travis.yml index 121b31d77f..13eacf7b53 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,7 +24,7 @@ matrix: - hadrian/build.sh selftest - os: linux - env: MODE="--flavour=quickest stage2" + env: MODE="--flavour=quickest" compiler: "GHC 8.2.2" addons: apt: @@ -46,7 +46,7 @@ matrix: - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- - os: linux - env: MODE="--flavour=quickest --integer-simple stage2" + env: MODE="--flavour=quickest --integer-simple" compiler: "GHC 8.4.1" addons: apt: @@ -72,7 +72,7 @@ matrix: - os: osx osx_image: xcode8 - env: MODE="--flavour=quickest --integer-simple stage2" + env: MODE="--flavour=quickest --integer-simple" before_install: - brew update - brew install ghc cabal-install diff --git a/appveyor.yml b/appveyor.yml index 87becefc4c..9c163f842c 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -39,8 +39,8 @@ build_script: - build selftest # Build GHC - - build -j --flavour=quickest --no-progress --progress-colour=never --profile=- stage2 + - build -j --flavour=quickest --no-progress --progress-colour=never --profile=- # Test GHC binary - cd .. - - inplace\bin\ghc-stage2 -e 1+2 + - _build/stage1/bin/ghc -e 1+2 From 75c6aacf4658f1a6ccfce583ee4dbc34b65a33c6 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 28 Mar 2018 21:37:47 +0200 Subject: [PATCH 24/28] attempt at fixing hadrian's -c option --- .travis.yml | 7 ++----- src/Rules/Configure.hs | 2 +- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/.travis.yml b/.travis.yml index 13eacf7b53..ac956f6098 100644 --- a/.travis.yml +++ b/.travis.yml @@ -39,11 +39,8 @@ matrix: - PATH="/opt/cabal/2.0/bin:$PATH" script: - # boot and configure ghc's source tree - - ./boot --hadrian && ./configure - - # Build GHC - - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- + # Build GHC, letting hadrian boot & configure the ghc source tree + - hadrian/build.sh -c -j $MODE --no-progress --progress-colour=never --profile=- - os: linux env: MODE="--flavour=quickest --integer-simple" diff --git a/src/Rules/Configure.hs b/src/Rules/Configure.hs index 9de31e2bbc..13dbe9cb40 100644 --- a/src/Rules/Configure.hs +++ b/src/Rules/Configure.hs @@ -12,7 +12,7 @@ import Utilities configureRules :: Rules () configureRules = do - [configFile, "settings", configH] &%> \outs -> do + [configFile, "settings", configH, "compiler/ghc.cabal"] &%> \outs -> do skip <- not <$> cmdConfigure if skip then unlessM (doesFileExist configFile) $ From 894a197b2db35ccb46bfffbb390ffde2a445c0bc Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 29 Mar 2018 02:08:47 +0200 Subject: [PATCH 25/28] .travis.yml: use -c everywhere again --- .travis.yml | 19 +++++-------------- 1 file changed, 5 insertions(+), 14 deletions(-) diff --git a/.travis.yml b/.travis.yml index ac956f6098..a008ffd368 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,12 +17,9 @@ matrix: - PATH="/opt/cabal/2.0/bin:$PATH" script: - # boot and configure ghc's source tree - - ./boot --hadrian && ./configure - # Run internal Hadrian tests - - hadrian/build.sh selftest - + - hadrian/build.sh -c selftest + - os: linux env: MODE="--flavour=quickest" compiler: "GHC 8.2.2" @@ -58,11 +55,8 @@ matrix: - PATH="/opt/cabal/2.2/bin:$PATH" script: - # boot and configure ghc's source tree - - ./boot --hadrian && ./configure - - # Build GHC - - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- + # Boot, configure and build GHC + - hadrian/build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- # Test GHC binary - _build/stage1/bin/ghc -e 1+2 @@ -76,12 +70,9 @@ matrix: - brew upgrade python script: - # boot and configure ghc's source tree - - ./boot --hadrian && ./configure - # Due to timeout limit of OS X build on Travis CI, # we will ignore selftest and build only stage1 - - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- + - hadrian/build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- # Test GHC binary - _build/stage1/bin/ghc -e 1+2 From 03eda8ae8c0219e750a138955d0744c9c9685af2 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 29 Mar 2018 18:02:34 +0200 Subject: [PATCH 26/28] travis: back to explicit './boot && ./configure' --- .travis.yml | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index a008ffd368..24159039fc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -17,8 +17,10 @@ matrix: - PATH="/opt/cabal/2.0/bin:$PATH" script: + # boot & configure ghc source tree + - ./boot && ./configure # Run internal Hadrian tests - - hadrian/build.sh -c selftest + - hadrian/build.sh selftest - os: linux env: MODE="--flavour=quickest" @@ -36,8 +38,11 @@ matrix: - PATH="/opt/cabal/2.0/bin:$PATH" script: + # boot & configure ghc source tree + - ./boot && ./configure + # Build GHC, letting hadrian boot & configure the ghc source tree - - hadrian/build.sh -c -j $MODE --no-progress --progress-colour=never --profile=- + - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- - os: linux env: MODE="--flavour=quickest --integer-simple" @@ -55,8 +60,11 @@ matrix: - PATH="/opt/cabal/2.2/bin:$PATH" script: - # Boot, configure and build GHC - - hadrian/build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- + # boot & configure ghc source tree + - ./boot && ./configure + + # build GHC + - hadrian/build.sh -j $MODE --no-progress --progress-colour=never --profile=- # Test GHC binary - _build/stage1/bin/ghc -e 1+2 @@ -70,6 +78,9 @@ matrix: - brew upgrade python script: + # boot and configure ghc source tree + - ./boot && ./configure + # Due to timeout limit of OS X build on Travis CI, # we will ignore selftest and build only stage1 - hadrian/build.sh -j -c $MODE --no-progress --progress-colour=never --profile=- From 770be1c6f3c792704cbcd46cd52d5c1a3e479f53 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Fri, 30 Mar 2018 17:41:51 +0200 Subject: [PATCH 27/28] update README.md and doc/user-settings.md to reflect configurable build root --- README.md | 19 ++++++++----------- doc/user-settings.md | 10 ---------- src/CommandLine.hs | 2 +- 3 files changed, 9 insertions(+), 22 deletions(-) diff --git a/README.md b/README.md index bdd8ed81f7..620d405627 100644 --- a/README.md +++ b/README.md @@ -57,6 +57,14 @@ are placed into `_build` and `inplace` directories. In addition to standard Shake flags (try `--help`), the build system currently supports several others: +* `--build-root=PATH` or `-oPATH`: specify the directory in which you want to store all +the build artifacts. If none is specified by the user, hadrian will store everything +under `_build/` at the top of ghc's source tree. Unlike GHC's make build system, +hadrian doesn't have any "inplace" logic left anymore. This option is therefore +useful for GHC developers who want to build GHC in different ways or at different +commits, from the same directory, and have the build products sit in different, +isolated folders. + * `--configure` or `-c`: use this flag to run the `boot` and `configure` scripts automatically, so that you don't have to remember to run them manually as you normally do when using Make (typically only in the first build): @@ -119,17 +127,6 @@ are currently not supported. To build a GHC source distribution tarball, run `build sdist-ghc`. -#### Installation - -To build and install GHC artifacts, run `build install`. - -By default, GHC will be installed to the specified _prefix_ path on your system, -relative to the root of the file system. For example on UNIX, GHC will be installed -to `/usr/local/bin`. By setting the command line flag `--install-destdir=[DESTDIR]`, -you can install GHC to path `DESTDIR/` instead. Make sure you use correct -absolute path as `DESTDIR` on Windows, e.g. `C:/path`, which installs GHC -into `C:/path/usr/local`. - #### Testing * `build validate` runs GHC tests by simply executing `make fast` in `testsuite/tests` diff --git a/doc/user-settings.md b/doc/user-settings.md index 1a89dd40ac..e3b38ce26b 100644 --- a/doc/user-settings.md +++ b/doc/user-settings.md @@ -5,16 +5,6 @@ You can customise Hadrian by copying the file `hadrian/src/UserSettings.hs` to copy the file your changes will be tracked by `git` and you can accidentally commit them). Here we document currently supported settings. -## Build directory - -Hadrian puts build results into `_build` directory by default, which is -specified by `userBuildRoot`: -```haskell --- | All build results are put into the 'buildRoot' directory. -userBuildRoot :: BuildRoot -userBuildRoot = BuildRoot "_build" -``` - ## Build flavour Build _flavour_ is a collection of build settings that fully define a GHC build diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 68e8b4ce06..a76b47cd0b 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -137,7 +137,7 @@ optDescrs = [ Option ['c'] ["configure"] (NoArg readConfigure) "Run the boot and configure scripts (if you do not want to run them manually)." , Option ['o'] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT") - "Where to store build artefacts. (Default _build)." + "Where to store build artifacts. (Default _build)." , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR") "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)." , Option [] ["freeze1"] (NoArg readFreeze1) From c569957c62233be076c307f9ec558748707efe20 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Fri, 30 Mar 2018 19:22:10 +0200 Subject: [PATCH 28/28] some more feedback --- src/Hadrian/Builder.hs | 11 ----------- src/Utilities.hs | 2 +- 2 files changed, 1 insertion(+), 12 deletions(-) diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs index 2c3ceb9ef3..5d645eea8c 100644 --- a/src/Hadrian/Builder.hs +++ b/src/Hadrian/Builder.hs @@ -125,17 +125,6 @@ buildWith = doWith runBuilderWith runInfo askWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action String askWith = doWith askBuilderWith askInfo --- | Print out information about the command being executed. -putInfo :: Show b => Target c b -> Action () -putInfo t = putProgressInfo =<< renderAction - ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo. - (digest $ inputs t) - (digest $ outputs t) - where - digest [] = "none" - digest [x] = x - digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)" - -- | Print out information about the command being executed. runInfo :: Show b => Target c b -> Action () runInfo t = putProgressInfo =<< renderAction diff --git a/src/Utilities.hs b/src/Utilities.hs index 279db9e180..57faf41fb5 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -48,7 +48,7 @@ contextDependencies ctx@Context {..} = do let newPkgs = nubOrd $ sort (deps ++ pkgs) if pkgs == newPkgs then return pkgs else go newPkgs step pkg = pkgDependencies (ctx { Context.package = pkg }) >>= \case - Nothing -> return [] -- non cabal package => no dependencies + Nothing -> return [] -- Non-Cabal packages have no dependencies. Just deps -> do active <- sort <$> stagePackages depStage return $ intersectOrd (compare . pkgName) active deps