From f10e62b41f2f6bd3db1963f8b3c35f7e8a481139 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 25 Oct 2017 16:15:20 +0800 Subject: [PATCH 001/210] Move package.conf.d into $build/$stage/lib --- src/Base.hs | 8 ++++---- src/Context.hs | 2 +- src/Rules/Register.hs | 4 ++-- src/Rules/Wrappers.hs | 4 +++- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/Base.hs b/src/Base.hs index 38c879234a..c72cecb3b2 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -76,16 +76,16 @@ generatedDir = "generated" -- | The directory in 'buildRoot' containing the 'Stage0' package database. stage0PackageDbDir :: FilePath -stage0PackageDbDir = "stage0/bootstrapping.conf" +stage0PackageDbDir = "stage0/lib/bootstrapping.conf" -- | Path to the inplace package database used in 'Stage1' and later. -inplacePackageDbPath :: FilePath -inplacePackageDbPath = "inplace/lib/package.conf.d" +inplacePackageDbPath :: Stage -> FilePath +inplacePackageDbPath 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 <&> (-/- inplacePackageDbPath stage) -- | We use a stamp file to track the existence of a package database. packageDbStamp :: FilePath diff --git a/src/Context.hs b/src/Context.hs index ad1a2d7295..bd3099a3a9 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -139,7 +139,7 @@ pkgConfFile Context {..} = do root <- buildRoot pid <- pkgId package let dbDir | stage == Stage0 = root -/- stage0PackageDbDir - | otherwise = inplacePackageDbPath + | otherwise = root -/- inplacePackageDbPath stage return $ dbDir -/- pid <.> "conf" -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath' diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 7c0a3e00e8..14be2b121b 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -22,10 +22,10 @@ registerPackage rs context@Context {..} = do buildStamp rs context when (stage == Stage1) $ do - inplacePackageDbPath -/- pkgName package ++ "*.conf" %%> + "//" ++ inplacePackageDbPath stage -/- pkgName package ++ "*.conf" %%> buildConf rs context - when (package == ghc) $ inplacePackageDbPath -/- packageDbStamp %> + when (package == ghc) $ "//" ++ inplacePackageDbPath stage -/- packageDbStamp %> buildStamp rs context buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs index 20763a778e..706c065caf 100644 --- a/src/Rules/Wrappers.hs +++ b/src/Rules/Wrappers.hs @@ -50,14 +50,16 @@ 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 -/- inplacePackageDbPath stage ++ " ${1+\"$@\"}" ] installGhcPkgWrapper :: WrappedBinary -> Expr String installGhcPkgWrapper WrappedBinary{..} = do From c4a297bfb8661ebc6e977b76b4d372feee4a3044 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:20:15 +0800 Subject: [PATCH 002/210] [hsc2hs] provide with staged template --- src/Settings/Builders/Hsc2Hs.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 6185f6bec3..8fafc628ba 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -15,6 +15,7 @@ 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" @@ -27,7 +28,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 $ "-I" ++ top -/- "inplace/lib/include/" , arg =<< getInput , arg "-o", arg =<< getOutput ] From 1f76250a5184a78a8f4e5ab5143d13314d8dde11 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:24:12 +0800 Subject: [PATCH 003/210] [ghc-pkg] provie the --global-package-db flag This allows to run it during the build without the wrapper. --- src/Settings/Builders/GhcPkg.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs index ba705c6892..2c78846cb9 100644 --- a/src/Settings/Builders/GhcPkg.hs +++ b/src/Settings/Builders/GhcPkg.hs @@ -10,7 +10,11 @@ ghcPkgBuilderArgs = mconcat 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 From 713617cc83828d2b1c031426e9b5c6c2458102c5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:25:12 +0800 Subject: [PATCH 004/210] [ghc-cabal] Pass down the --global-package-db flag to ghc-pkg Again, if ghc-pkg is run without a wrapper, we need to provide it with the flag. --- src/Settings/Builders/GhcCabal.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index bfb84a76ec..4b6fb339ce 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -13,7 +13,8 @@ ghcCabalBuilderArgs = builder GhcCabal ? do verbosity <- expr getVerbosity top <- expr topDirectory path <- getBuildPath - notStage0 ? expr (need inplaceLibCopyTargets) + stage <- getStage + notStage0 ? expr (need =<< inplaceLibCopyTargets stage) mconcat [ arg "configure" , arg =<< pkgPath <$> getPackage , arg $ top -/- path @@ -104,6 +105,15 @@ 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 @@ -112,6 +122,7 @@ with b = do top <- expr topDirectory expr $ needBuilder b arg $ withBuilderKey b ++ unifyPath (top path) + withBuilderArgs b withStaged :: (Stage -> Builder) -> Args withStaged sb = with . sb =<< getStage From cc3ca47c4831381f980eb1f98cf510337119e6f6 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:25:20 +0800 Subject: [PATCH 005/210] test --- src/Rules/Test.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 294f8f0ea4..8fd379415a 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -13,7 +13,8 @@ import Utilities testRules :: Rules () testRules = do "validate" ~> do - need inplaceLibCopyTargets + need =<< inplaceLibCopyTargets Stage1 + need =<< inplaceLibCopyTargets Stage2 needBuilder $ Ghc CompileHs Stage2 needBuilder $ GhcPkg Update Stage1 needBuilder Hpc From e955497bc2d459cfdf94787212928566144829f0 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:26:24 +0800 Subject: [PATCH 006/210] [Programs] install in $stage/bin No more /inplace/ logic. --- src/Rules/Program.hs | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index ba4dab0442..fc994fc227 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -17,23 +17,16 @@ import Utilities -- | TODO: Drop code duplication buildProgram :: [(Resource, Int)] -> Package -> Rules () buildProgram rs package = do - forM_ [Stage0 ..] $ \stage -> do - let context = vanillaContext stage package + forM_ [Stage1 ..] $ \stage -> do + let context = vanillaContext (pred stage) package -- Rules for programs built in 'buildRoot' - "//" ++ contextDir context -/- programName context <.> exe %> \bin -> - buildBinaryAndWrapper rs bin =<< programContext stage package + "//" ++ stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> + buildBinary rs bin =<< programContext (pred stage) package -- Rules for the GHC package, which is built 'inplace' - when (package == ghc) $ do - inplaceBinPath -/- programName context <.> exe %> \bin -> - buildBinaryAndWrapper rs bin =<< programContext stage package - inplaceLibBinPath -/- programName context <.> exe %> \bin -> - buildBinary rs bin =<< programContext stage package - inplaceLibBinPath -/- programName context <.> "bin" %> \bin -> - buildBinary rs bin =<< programContext stage package -- Rules for other programs built in inplace directories when (package /= ghc) $ do From 315b63292477e3c3928975c2e2332880759872d8 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:26:32 +0800 Subject: [PATCH 007/210] dead install for now. --- src/Rules/Install.hs | 314 +------------------------------------------ 1 file changed, 1 insertion(+), 313 deletions(-) diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs index 45586466f3..8ae5c4f801 100644 --- a/src/Rules/Install.hs +++ b/src/Rules/Install.hs @@ -1,313 +1 @@ -module Rules.Install (installRules) 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 = do - "install" ~> do - installIncludes - installPackageConf - installCommonLibs - installLibExecs - installLibExecScripts - installBins - installPackages - --- 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 = (-/- "bin") <$> installGhcLibDir - --- 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 -> do - withInstallStage pkg $ \stage -> do - context <- programContext stage pkg - let bin = inplaceLibBinPath -/- programName context <.> exe - installProgram bin (destDir ++ libExecDir) - when (pkg == ghc) $ do - 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 $ map (Context Stage1 rts) ways - ffiLibs <- sequence $ map rtsLibffiLibrary ways - - -- TODO: Add dynamic ones - forM_ (rtsLibs ++ ffiLibs) $ \lib -> installData [lib] rtsDir - - -- HACK (issue #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 (izgzhen): 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 -> do - 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 - let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal" <.> exe -- HACK? - need [ghcCabalInplace] - - pkgConf <- pkgConfFile context - need [cabalFile, pkgConf] -- TODO: check if need pkgConf - - -- HACK (#318): copy stuff back to the place favored by ghc-cabal - quietly $ copyDirectoryContentsUntracked (Not excluded) - installDistDir (installDistDir -/- "build") - - pref <- setting InstallPrefix - unit $ cmd ghcCabalInplace [ "copy" - , pkgPath pkg - , absInstallDistDir - , strip - , destDir - , pref - , ghclibDir - , docDir -/- "html/libraries" - , intercalate " " (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 -> do - 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 -> do - 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 +module Rules.Install () where From b0359ed6d89bf6bfeb5d6204a14d2cf1f7ae0f34 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:27:02 +0800 Subject: [PATCH 008/210] More elaborate generate logic. --- src/Rules/Generate.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index e777e1b2ca..4569e223c8 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -143,12 +143,14 @@ generatePackageCode context@(Context stage pkg _) = 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) + forM_ [Stage0 ..] $ \stage -> do + let prefix = ("//" ++ 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) "//c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c") "//c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c") where From 163683648fbcf639ad671582b16674734cb9fa35 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:27:32 +0800 Subject: [PATCH 009/210] dead install --- src/Main.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 52af0adf7c..926b4d819c 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 @@ -45,7 +44,6 @@ main = do Rules.buildRules Rules.Documentation.documentationRules Rules.Clean.cleanRules - Rules.Install.installRules Rules.oracleRules Rules.Selftest.selftestRules Rules.SourceDist.sourceDistRules From 500336f57da2035c5830d46eaf1f79adbe7dc508 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:27:51 +0800 Subject: [PATCH 010/210] [ghc] no more stages, no more inplace --- src/GHC.hs | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 77a63e92d7..868ca9b455 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -207,7 +207,7 @@ stage2Packages = do -- 'Library', the function simply returns its name. programName :: Context -> String programName Context {..} - | package == ghc = "ghc-stage" ++ show (fromEnum stage + 1) + | package == ghc = "ghc" | package == hpcBin = "hpc" | package == runGhc = "runhaskell" | package == iservBin = "ghc-iserv" @@ -232,19 +232,14 @@ isBuiltInplace :: Context -> Action Bool isBuiltInplace Context {..} | isLibrary package = return False | not (isGhcPackage package) = return False - | package == ghc = return True + | package == ghc = return False | 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 + return $ path -/- programName context <.> 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 From c99ef5b2f3fc4fc774cd12ceb83ec87b3e729a93 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:29:09 +0800 Subject: [PATCH 011/210] [Builders] most of them are in stage1/bin now, instead of stage0. This might need some rethinking, as we might want to rebuild them per stage (or copy?) We could e.g. build them in stage0, and just copy them into stage1 and stage2. --- src/Builder.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index fdd73e7a8e..3cad9910fd 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -126,18 +126,18 @@ instance NFData Builder -- 'Stage' and GHC 'Package'). builderProvenance :: Builder -> Maybe Context builderProvenance = \case - DeriveConstants -> context Stage0 deriveConstants - GenApply -> context Stage0 genapply - GenPrimopCode -> context Stage0 genprimopcode + DeriveConstants -> context Stage1 deriveConstants + GenApply -> context Stage1 genapply + GenPrimopCode -> context Stage1 genprimopcode Ghc _ Stage0 -> Nothing - Ghc _ stage -> context (pred stage) ghc - GhcCabal -> context Stage0 ghcCabal + Ghc _ stage -> context stage ghc + GhcCabal -> context Stage1 ghcCabal GhcPkg _ Stage0 -> Nothing - GhcPkg _ _ -> context Stage0 ghcPkg + GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock Hpc -> context Stage1 hpcBin - Hsc2Hs -> context Stage0 hsc2hs - Unlit -> context Stage0 unlit + Hsc2Hs -> context Stage1 hsc2hs + Unlit -> context Stage1 unlit _ -> Nothing where context s p = Just $ vanillaContext s p From 0ecb08928e6071dfec4a46795137a3ccbff52cdb Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:29:25 +0800 Subject: [PATCH 012/210] [base] less in-place logic. --- src/Base.hs | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/src/Base.hs b/src/Base.hs index c72cecb3b2..cb937668a2 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -21,6 +21,7 @@ module Base ( -- * Paths hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir, generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, + stageBinPath, stageLibPath, inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir, inplacePackageDbPath, packageDbPath, packageDbStamp ) where @@ -103,19 +104,25 @@ inplaceLibPath = "inplace/lib" inplaceLibBinPath :: FilePath inplaceLibBinPath = "inplace/lib/bin" +stageBinPath :: Stage -> Action FilePath +stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin") + +stageLibPath :: Stage -> Action FilePath +stageLibPath stage = buildRoot <&> (-/- stageString stage -/- "lib") + -- ref: ghc/ghc.mk:142 -- ref: driver/ghc.mk -- ref: utils/hsc2hs/ghc.mk:35 -- | 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" ] +inplaceLibCopyTargets :: Stage -> Action [FilePath] +inplaceLibCopyTargets stage = mapM (\f -> stageLibPath stage <&> (-/- f)) + [ "ghc-usage.txt" + , "ghci-usage.txt" + , "llvm-targets" + , "platformConstants" + , "settings" + , "template-hsc.h" ] -- | Path to hsc2hs template. -templateHscPath :: FilePath -templateHscPath = "inplace/lib/template-hsc.h" +templateHscPath :: Stage -> Action FilePath +templateHscPath stage = stageLibPath stage <&> (-/- "/template-hsc.h") From 89bd0fe96bae49bd2a4491c214cd9727472e3722 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:30:39 +0800 Subject: [PATCH 013/210] [Rules] Copy rules for multiple stages This again should probably be done by having the package depend on the right files. ghc depends on settings, llvm-targets, platformConstants and the ghc/ghci-usage.txt files. hsc2hs depends on the template. --- src/Rules.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 97270a63da..ce650dec1c 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -37,12 +37,14 @@ topLevelTargets = action $ do libs <- concatForM [Stage0, Stage1] $ \stage -> concatForM libraryPackages $ packageTargets False stage prgs <- concatForM programsStage1Only $ packageTargets False Stage0 - return $ libs ++ prgs ++ inplaceLibCopyTargets + cpys <- concatForM [Stage0, Stage1] $ inplaceLibCopyTargets + return $ libs ++ prgs ++ cpys else do targets <- concatForM allStages $ \stage -> concatForM (knownPackages \\ [libffi]) $ packageTargets False stage - return $ targets ++ inplaceLibCopyTargets + cpys <- concatForM allStages $ inplaceLibCopyTargets + return $ targets ++ cpys -- TODO: Get rid of the @includeGhciLib@ hack. -- | Return the list of targets associated with a given 'Stage' and 'Package'. From 523139ebab4c5f86f5a4f2cd3a6393732ef9db62 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:44:29 +0800 Subject: [PATCH 014/210] [hsc2hs] Staged, and dependent on template-hsc.h --- src/Builder.hs | 6 +++--- src/Oracles/ModuleFiles.hs | 22 +++++++++++----------- src/Rules/Program.hs | 6 +++++- 3 files changed, 19 insertions(+), 15 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 3cad9910fd..0c856a026a 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -103,7 +103,7 @@ data Builder = Alex | Happy | Hpc | HsCpp - | Hsc2Hs + | Hsc2Hs Stage | Ld | Make FilePath | Nm @@ -136,7 +136,7 @@ builderProvenance = \case GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock Hpc -> context Stage1 hpcBin - Hsc2Hs -> context Stage1 hsc2hs + Hsc2Hs stage -> context stage hsc2hs Unlit -> context Stage1 unlit _ -> Nothing where @@ -153,7 +153,7 @@ instance H.Builder Builder where path <- H.builderPath builder case builder of Configure dir -> need [dir -/- "configure"] - Hsc2Hs -> need [path, templateHscPath] + Hsc2Hs stage -> templateHscPath stage >>= \tmpl -> need [path, tmpl] Make dir -> need [dir -/- "Makefile"] _ -> when (isJust $ builderProvenance builder) $ need [path] diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index 9a54a2ab03..2706d5113a 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -26,19 +26,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 +71,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'. @@ -134,7 +134,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 fe f = compare (dropExtension fe) f found = intersectOrd cmp files mFiles return (map (fullDir -/-) found, mDir) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index fc994fc227..ae36c91f91 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -21,7 +21,11 @@ buildProgram rs package = do let context = vanillaContext (pred stage) package -- Rules for programs built in 'buildRoot' - "//" ++ stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> + "//" ++ stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do + when (package == hsc2hs) $ do + -- hsc2hs needs the template-hsc.h file + tmpl <- templateHscPath stage + need [tmpl] buildBinary rs bin =<< programContext (pred stage) package -- Rules for the GHC package, which is built 'inplace' From e41f93988aa2a768f7252abd177d14cab6327027 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 26 Oct 2017 15:55:28 +0800 Subject: [PATCH 015/210] [hsc2hs,ghc] drop inplace copy targets. hsc depends on the template-hsc.h, and ghc depends on settings, platformConstants, llvm-targets, ghc-usage.txt, ghci-usage.txt. As such they will bring the files in on their own, and the copy target logic is no longer required. --- src/Base.hs | 14 +++++--------- src/Builder.hs | 1 + src/Rules.hs | 6 ++---- src/Rules/Program.hs | 4 ++++ src/Rules/Test.hs | 2 -- src/Settings/Builders/GhcCabal.hs | 1 - 6 files changed, 12 insertions(+), 16 deletions(-) diff --git a/src/Base.hs b/src/Base.hs index cb937668a2..49328a4dbd 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -22,7 +22,7 @@ module Base ( hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir, generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, stageBinPath, stageLibPath, - inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir, + ghcDeps, templateHscPath, stage0PackageDbDir, inplacePackageDbPath, packageDbPath, packageDbStamp ) where @@ -110,18 +110,14 @@ stageBinPath stage = buildRoot <&> (-/- stageString stage -/- "bin") stageLibPath :: Stage -> Action FilePath stageLibPath stage = buildRoot <&> (-/- stageString stage -/- "lib") --- ref: ghc/ghc.mk:142 --- ref: driver/ghc.mk --- ref: utils/hsc2hs/ghc.mk:35 --- | Files that need to be copied over to 'inplaceLibPath'. -inplaceLibCopyTargets :: Stage -> Action [FilePath] -inplaceLibCopyTargets stage = mapM (\f -> stageLibPath stage <&> (-/- f)) +-- | 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" - , "template-hsc.h" ] + , "settings" ] -- | Path to hsc2hs template. templateHscPath :: Stage -> Action FilePath diff --git a/src/Builder.hs b/src/Builder.hs index 0c856a026a..391fa1ab9c 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -136,6 +136,7 @@ builderProvenance = \case GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock Hpc -> context Stage1 hpcBin + Hsc2Hs Stage0 -> context Stage1 hsc2hs Hsc2Hs stage -> context stage hsc2hs Unlit -> context Stage1 unlit _ -> Nothing diff --git a/src/Rules.hs b/src/Rules.hs index ce650dec1c..22c6350cc9 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -37,14 +37,12 @@ topLevelTargets = action $ do libs <- concatForM [Stage0, Stage1] $ \stage -> concatForM libraryPackages $ packageTargets False stage prgs <- concatForM programsStage1Only $ packageTargets False Stage0 - cpys <- concatForM [Stage0, Stage1] $ inplaceLibCopyTargets - return $ libs ++ prgs ++ cpys + return $ libs ++ prgs else do targets <- concatForM allStages $ \stage -> concatForM (knownPackages \\ [libffi]) $ packageTargets False stage - cpys <- concatForM allStages $ inplaceLibCopyTargets - return $ targets ++ cpys + return targets -- TODO: Get rid of the @includeGhciLib@ hack. -- | Return the list of targets associated with a given 'Stage' and 'Package'. diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index ae36c91f91..3d29399cc1 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -26,6 +26,10 @@ buildProgram rs package = 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 buildBinary rs bin =<< programContext (pred stage) package -- Rules for the GHC package, which is built 'inplace' diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 8fd379415a..4463767d92 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -13,8 +13,6 @@ import Utilities testRules :: Rules () testRules = do "validate" ~> do - need =<< inplaceLibCopyTargets Stage1 - need =<< inplaceLibCopyTargets Stage2 needBuilder $ Ghc CompileHs Stage2 needBuilder $ GhcPkg Update Stage1 needBuilder Hpc diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 4b6fb339ce..3725967db5 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -14,7 +14,6 @@ ghcCabalBuilderArgs = builder GhcCabal ? do top <- expr topDirectory path <- getBuildPath stage <- getStage - notStage0 ? expr (need =<< inplaceLibCopyTargets stage) mconcat [ arg "configure" , arg =<< pkgPath <$> getPackage , arg $ top -/- path From 1afd1c25c1a7384d1256a2cddcfa61f77b7fca65 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 16:28:33 +0800 Subject: [PATCH 016/210] buildPath -> contextPath --- src/Context.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index bd3099a3a9..0a64bbe81d 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -69,9 +69,13 @@ withHsPackage expr = do 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) + -- | Path to the directory containing build artefacts of a given 'Context'. buildPath :: Context -> Action FilePath -buildPath context = buildRoot <&> (-/- contextDir context) +buildPath context = buildRoot <&> (-/- (buildDir context)) -- | Get the build path of the current 'Context'. getBuildPath :: Expr Context b FilePath @@ -91,19 +95,19 @@ pkgFile context@Context {..} prefix suffix = do -- | 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.: From 88a2a2cc6ba1a408cf65580aca7fede984aff9e7 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 17:52:22 +0800 Subject: [PATCH 017/210] Build ContextPath rewrite --- src/Context.hs | 25 +++++++++++++++++++++---- src/Expression.hs | 4 ++-- src/GHC.hs | 2 +- src/Oracles/ModuleFiles.hs | 8 ++++---- src/Rules/Compile.hs | 6 +++--- src/Rules/Generate.hs | 6 +++--- src/Rules/Library.hs | 4 ++-- src/Rules/PackageData.hs | 4 ++-- src/Rules/Program.hs | 2 +- src/Settings/Builders/GhcCabal.hs | 2 +- 10 files changed, 40 insertions(+), 23 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index 0a64bbe81d..362d233ba0 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -7,9 +7,10 @@ module Context ( withHsPackage, -- * Paths - contextDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile, - pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile, - pkgConfFile, objectPath + buildDir, contextPath, getContextPath, + contextDir, contextInstallDir, buildPath, pkgInplaceConfig, pkgDataFile, + pkgSetupConfigFile, pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, + pkgGhciLibraryFile, pkgConfFile, objectPath, pkgId ) where import GHC.Generics @@ -73,6 +74,13 @@ contextDir Context {..} = stageString stage -/- pkgPath package 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 artefacts. +buildDir :: Context -> FilePath +buildDir context = contextDir context -/- "build" + -- | Path to the directory containing build artefacts of a given 'Context'. buildPath :: Context -> Action FilePath buildPath context = buildRoot <&> (-/- (buildDir context)) @@ -86,9 +94,18 @@ pkgId package = case pkgCabalFile package of Just file -> pkgIdentifier file Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts +-- | The directroy in 'buildRoot' that will hold the final install artifact for a given 'Context'. +contextInstallDir :: Context -> FilePath +contextInstallDir Context {..} = stageString stage -/- "lib" + +-- | Path to the directory containg the final artifact in a given 'Context' +installPath :: Context -> Action FilePath +installPath context = buildRoot <&> (-/- contextInstallDir context) + + pkgFile :: Context -> String -> String -> Action FilePath pkgFile context@Context {..} prefix suffix = do - path <- buildPath context + path <- installPath context pid <- pkgId package return $ path -/- prefix ++ pid ++ suffix diff --git a/src/Expression.hs b/src/Expression.hs index 7e8220e675..b7e1838e08 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -45,11 +45,11 @@ type Ways = Expr [Way] -- | Get a value from the @package-data.mk@ file of the current context. getPkgData :: (FilePath -> PackageData) -> Expr String -getPkgData key = expr . pkgData . key =<< getBuildPath +getPkgData key = expr . pkgData . key =<< getContextPath -- | 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 +getPkgDataList key = expr . pkgDataList . key =<< getContextPath -- | Is the build currently in the provided stage? stage :: Stage -> Predicate diff --git a/src/GHC.hs b/src/GHC.hs index 868ca9b455..a2a23829f6 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -261,7 +261,7 @@ 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") -- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is -- generated in "Rules.Generators.GhcSplit". diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index 2706d5113a..d4a8ff2b3a 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -88,7 +88,7 @@ hsSources context = do -- the build directory regardless of whether they are generated or not. hsObjects :: Context -> Action [FilePath] hsObjects context = do - path <- buildPath context + path <- contextPath 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) @@ -96,7 +96,7 @@ hsObjects context = do -- | Generated module files live in the 'Context' specific build directory. generatedFile :: Context -> String -> Action FilePath generatedFile context moduleName = do - path <- buildPath context + path <- contextPath context return $ path -/- moduleSource moduleName moduleSource :: String -> FilePath @@ -105,7 +105,7 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" -- | Module files for a given 'Context'. contextFiles :: Context -> Action [(String, Maybe FilePath)] contextFiles context@Context {..} = do - path <- buildPath context + path <- contextPath context modules <- fmap sort . pkgDataList $ Modules path zip modules <$> askOracle (ModuleFiles (stage, package)) @@ -124,7 +124,7 @@ moduleFilesOracle :: Rules () moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package - path <- buildPath context + path <- contextPath context srcDirs <- pkgDataList $ SrcDirs path modules <- fmap sort . pkgDataList $ Modules path autogen <- autogenPath context diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs index a4b1278660..82c0ac135e 100644 --- a/src/Rules/Compile.hs +++ b/src/Rules/Compile.hs @@ -11,7 +11,7 @@ import Utilities compilePackage :: [(Resource, Int)] -> Context -> Rules () compilePackage rs context@Context {..} = do - let dir = "//" ++ contextDir context + let dir = "//" ++ buildDir context nonHs extension = dir -/- extension "*" <.> osuf way compile compiler obj2src obj = do src <- obj2src context obj @@ -19,7 +19,7 @@ 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 when (isLibrary package) $ need =<< return <$> pkgConfFile context @@ -78,6 +78,6 @@ obj2src extension isGenerated context@Context {..} obj where src = obj -<.> extension suffix = do - path <- buildPath context + path <- contextPath context return $ fromMaybe ("Cannot determine source for " ++ obj) $ stripPrefix (path -/- extension) src diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 4569e223c8..9fb6189e29 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -27,7 +27,7 @@ primopsTxt :: Stage -> FilePath primopsTxt stage = contextDir (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" isGeneratedCFile :: FilePath -> Bool isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"] @@ -44,7 +44,7 @@ includesDependencies = fmap (generatedDir -/-) ghcPrimDependencies :: Expr [FilePath] ghcPrimDependencies = do stage <- getStage - path <- expr $ buildPath (vanillaContext stage ghcPrim) + path <- expr $ contextPath (vanillaContext stage ghcPrim) return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"] derivedConstantsDependencies :: [FilePath] @@ -59,7 +59,7 @@ compilerDependencies = do root <- getBuildRoot stage <- getStage intLib <- expr (integerLibrary =<< flavour) - ghcPath <- expr $ buildPath (vanillaContext stage compiler) + ghcPath <- expr $ contextPath (vanillaContext stage compiler) gmpPath <- expr gmpBuildPath rtsPath <- expr rtsBuildPath mconcat [ return [root -/- platformH stage] diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index e6e5b167ff..7db66a2eca 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -78,7 +78,7 @@ allObjects context = (++) <$> nonHsObjects context <*> hsObjects context nonHsObjects :: Context -> Action [FilePath] nonHsObjects context = do - path <- buildPath context + path <- contextPath context cObjs <- cObjects context cmmSrcs <- pkgDataList (CmmSrcs path) cmmObjs <- mapM (objectPath context) cmmSrcs @@ -87,7 +87,7 @@ nonHsObjects context = do cObjects :: Context -> Action [FilePath] cObjects context = do - path <- buildPath context + path <- contextPath context srcs <- pkgDataList (CSrcs path) objs <- mapM (objectPath context) srcs return $ if way context == threaded diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 2442b03de3..5d51692abc 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -32,7 +32,7 @@ buildPackageData context@Context {..} = do -- TODO: Get rid of hardcoded file paths. dir -/- "inplace-pkg-config" %> \conf -> do - path <- buildPath context + path <- contextPath context dataFile <- pkgDataFile context need [dataFile] -- ghc-cabal builds inplace package configuration file if package == rts @@ -112,7 +112,7 @@ postProcessPackageData :: Context -> FilePath -> Action () postProcessPackageData context@Context {..} file = do top <- topDirectory cmmSrcs <- getDirectoryFiles (pkgPath package) ["cbits/*.cmm"] - path <- buildPath context + path <- contextPath context let len = length (pkgPath package) + length (top -/- path) + 2 fixFile file $ unlines . (++ ["CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) ]) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 3d29399cc1..915b2f0af0 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -103,7 +103,7 @@ buildBinary rs bin context@Context {..} = do when (stage > Stage0) $ do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ rtsContext { way = w } | w <- ways ] - path <- buildPath context + path <- contextPath context cSrcs <- pkgDataList (CSrcs path) cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 3725967db5..5da7eb8c48 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -12,7 +12,7 @@ ghcCabalBuilderArgs :: Args ghcCabalBuilderArgs = builder GhcCabal ? do verbosity <- expr getVerbosity top <- expr topDirectory - path <- getBuildPath + path <- getContextPath stage <- getStage mconcat [ arg "configure" , arg =<< pkgPath <$> getPackage From 3206db37b25a6ee85d63ed29133f72a0ed503b9a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 17:53:18 +0800 Subject: [PATCH 018/210] reinstante /build folder --- src/Rules/Libffi.hs | 6 +++--- src/Rules/PackageData.hs | 5 +---- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index 9641b66650..2f588924d1 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -46,7 +46,7 @@ configureEnvironment = do libffiRules :: Rules () libffiRules = do - fmap ("//rts" -/-) libffiDependencies &%> \_ -> do + fmap ("//rts/build" -/-) libffiDependencies &%> \_ -> do libffiPath <- libffiBuildPath need [libffiPath -/- libffiLibrary] @@ -75,7 +75,7 @@ libffiRules = do putSuccess $ "| Successfully built custom library 'libffi'" - "//libffi/Makefile.in" %> \mkIn -> do + "//libffi/build/Makefile.in" %> \mkIn -> do libffiPath <- libffiBuildPath removeDirectory libffiPath tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" @@ -97,7 +97,7 @@ libffiRules = do fixFile mkIn (fixLibffiMakefile top) -- TODO: Get rid of hard-coded @libffi@. - "//libffi/Makefile" %> \mk -> do + "//libffi/build/Makefile" %> \mk -> do need [mk <.> "in"] libffiPath <- libffiBuildPath forM_ ["config.guess", "config.sub"] $ \file -> diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 5d51692abc..27c94ac8c7 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -35,8 +35,7 @@ buildPackageData context@Context {..} = do path <- contextPath context dataFile <- pkgDataFile context need [dataFile] -- ghc-cabal builds inplace package configuration file - if package == rts - then do + when (package == rts) $ do genPath <- buildRoot <&> (-/- generatedDir) rtsPath <- rtsBuildPath need [rtsConfIn] @@ -47,8 +46,6 @@ buildPackageData context@Context {..} = do . 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 From 2fcbde2498b62d72f804597fe4c5e672c0c45303 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 17:54:10 +0800 Subject: [PATCH 019/210] Full package names; and build dir. --- src/Rules/Library.hs | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 7db66a2eca..29758ce627 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -3,6 +3,7 @@ module Rules.Library ( ) where import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Parse as Cabal import qualified System.Directory as IO import Base @@ -36,7 +37,16 @@ libraryObjects context@Context{..} = do buildDynamicLib :: Context -> Rules () buildDynamicLib context@Context{..} = do - let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package + pkgId <- case pkgCabalFile package of + Just file -> do + cabal <- liftIO $ parseCabal file + return $ if (null $ version cabal) + then Cabal.name cabal + else Cabal.name cabal ++ "-" ++ version cabal + Nothing -> return (pkgName package) + + -- let libPrefix = "//" ++ contextInstallDir context -/- "libHS" ++ pkgId + let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgName package -- OS X libPrefix ++ "*.dylib" %> buildDynamicLibUnix -- Linux @@ -51,8 +61,17 @@ buildDynamicLib context@Context{..} = do buildPackageLibrary :: Context -> Rules () buildPackageLibrary context@Context {..} = do - let libPrefix = "//" ++ contextDir context -/- "libHS" ++ pkgName package - libPrefix ++ "*" ++ (waySuffix way <.> "a") %%> \a -> do + pkgId <- case pkgCabalFile package of + Just file -> do + cabal <- liftIO $ parseCabal file + return $ if (null $ version cabal) + then Cabal.name cabal + else Cabal.name cabal ++ "-" ++ version cabal + Nothing -> return (pkgName package) + + let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgId + archive = libPrefix ++ (waySuffix way <.> "a") + archive %%> \a -> do objs <- libraryObjects context asuf <- libsuf way let isLib0 = ("//*-0" ++ asuf) ?== a @@ -64,11 +83,19 @@ buildPackageLibrary context@Context {..} = do unless isLib0 . putSuccess $ renderLibrary (quote (pkgName package) ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") a synopsis + let instPrefix = "//" ++ contextInstallDir context -/- "libHS" ++ pkgId + instArchive = instPrefix ++ (waySuffix way <.> "a") + + instArchive %%> \a -> do + archive <- buildRoot <&> (-/- (buildDir context -/- "libHS" ++ pkgId ++ (waySuffix way <.> "a"))) + need [archive] + -- TODO: ghc-cabal copy; register buildPackageGhciLibrary :: Context -> Rules () buildPackageGhciLibrary context@Context {..} = priority 2 $ do let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package - libPrefix ++ "*" ++ (waySuffix way <.> "o") %> \obj -> do + o = libPrefix ++ "*" ++ (waySuffix way <.> "o") + o %> \obj -> do objs <- allObjects context need objs build $ target context Ld objs [obj] From a2805b6833f00d064236be3b14c92f47debe4b8a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 17:54:17 +0800 Subject: [PATCH 020/210] stage munging. --- src/Builder.hs | 3 +-- src/Rules.hs | 5 +++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 391fa1ab9c..aa9000a191 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -136,8 +136,7 @@ builderProvenance = \case GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock Hpc -> context Stage1 hpcBin - Hsc2Hs Stage0 -> context Stage1 hsc2hs - Hsc2Hs stage -> context stage hsc2hs + Hsc2Hs stage -> context (succ stage) hsc2hs Unlit -> context Stage1 unlit _ -> Nothing where diff --git a/src/Rules.hs b/src/Rules.hs index 22c6350cc9..cf22caa890 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -24,8 +24,9 @@ import UserSettings (stage1Only) import Target import Utilities + allStages :: [Stage] -allStages = [minBound ..] +allStages = [minBound .. (pred maxBound)] -- | This rule calls 'need' on all top-level build targets, respecting the -- 'Stage1Only' flag. @@ -71,7 +72,7 @@ packageTargets includeGhciLib stage pkg = do ++ [ haddock | pkg /= rts && docs && stage == Stage1 ] ++ libs ++ more else do -- The only target of a program package is the executable. - prgContext <- programContext stage pkg + prgContext <- programContext (succ stage) pkg prgPath <- programPath prgContext return [prgPath] From 8d430075081b2ca3cedcf426bdd5d61f9a74f2ba Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 21:20:27 +0800 Subject: [PATCH 021/210] [ghc-cabal] commands configure/copy/reg --- src/Builder.hs | 14 +++++++++++--- src/Rules/PackageData.hs | 2 +- src/Settings/Builders/GhcCabal.hs | 2 +- src/Settings/Packages/Base.hs | 2 +- src/Settings/Packages/Compiler.hs | 2 +- src/Settings/Packages/Ghc.hs | 4 ++-- src/Settings/Packages/GhcPkg.hs | 2 +- src/Settings/Packages/GhcPrim.hs | 2 +- src/Settings/Packages/Ghci.hs | 2 +- src/Settings/Packages/Haddock.hs | 2 +- src/Settings/Packages/Haskeline.hs | 2 +- src/Settings/Packages/IntegerGmp.hs | 2 +- 12 files changed, 23 insertions(+), 15 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index aa9000a191..13de782592 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -1,7 +1,7 @@ {-# LANGUAGE InstanceSigs #-} module Builder ( -- * Data types - ArMode (..), CcMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..), + ArMode (..), CcMode (..), GhcCabalMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..), SphinxMode (..), TarMode (..), Builder (..), -- * Builder properties @@ -51,6 +51,14 @@ 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) @@ -97,7 +105,7 @@ data Builder = Alex | GenApply | GenPrimopCode | Ghc GhcMode Stage - | GhcCabal + | GhcCabal GhcCabalMode Stage | GhcPkg GhcPkgMode Stage | Haddock HaddockMode | Happy @@ -131,7 +139,7 @@ builderProvenance = \case GenPrimopCode -> context Stage1 genprimopcode Ghc _ Stage0 -> Nothing Ghc _ stage -> context stage ghc - GhcCabal -> context Stage1 ghcCabal + GhcCabal _ stage -> context stage ghcCabal GhcPkg _ Stage0 -> Nothing GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 27c94ac8c7..c706ef75fb 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -27,7 +27,7 @@ buildPackageData context@Context {..} = do need =<< mapM pkgConfFile =<< contextDependencies context need [cabalFile] - build $ target context GhcCabal [cabalFile] [mk, setupConfig] + build $ target context (GhcCabal Conf stage) [cabalFile] [mk, setupConfig] postProcessPackageData context mk -- TODO: Get rid of hardcoded file paths. diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 5da7eb8c48..b06b206dd4 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -9,7 +9,7 @@ import Flavour import Settings.Builders.Common ghcCabalBuilderArgs :: Args -ghcCabalBuilderArgs = builder GhcCabal ? do +ghcCabalBuilderArgs = builder (GhcCabal Conf) ? do verbosity <- expr getVerbosity top <- expr topDirectory path <- getContextPath diff --git a/src/Settings/Packages/Base.hs b/src/Settings/Packages/Base.hs index bea52108a3..d8bc1eedba 100644 --- a/src/Settings/Packages/Base.hs +++ b/src/Settings/Packages/Base.hs @@ -6,6 +6,6 @@ import Settings basePackageArgs :: Args basePackageArgs = package base ? do integerLibrary <- expr integerLibraryName - mconcat [ builder GhcCabal ? arg ("--flags=" ++ integerLibrary) + mconcat [ builder (GhcCabal Conf) ? arg ("--flags=" ++ integerLibrary) -- Fix the 'unknown symbol stat' issue, see #259. , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ] diff --git a/src/Settings/Packages/Compiler.hs b/src/Settings/Packages/Compiler.hs index 1e12dbeb68..3a6b2f4b67 100644 --- a/src/Settings/Packages/Compiler.hs +++ b/src/Settings/Packages/Compiler.hs @@ -20,7 +20,7 @@ compilerPackageArgs = package compiler ? do , input "//Parser.hs" ? pure ["-O0", "-fno-ignore-interface-pragmas", "-fcmm-sink" ] ] - , builder GhcCabal ? mconcat + , builder (GhcCabal Conf) ? mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show (fromEnum stage + 1) , arg "--disable-library-for-ghci" , anyTargetOs ["openbsd"] ? arg "--ld-options=-E" diff --git a/src/Settings/Packages/Ghc.hs b/src/Settings/Packages/Ghc.hs index d7b1d78ddd..a9e82d2c64 100644 --- a/src/Settings/Packages/Ghc.hs +++ b/src/Settings/Packages/Ghc.hs @@ -9,5 +9,5 @@ ghcPackageArgs = package ghc ? do stage <- getStage path <- expr $ buildPath (vanillaContext stage compiler) mconcat [ builder Ghc ? arg ("-I" ++ path) - , builder GhcCabal ? ghcWithInterpreter ? notStage0 ? arg "--flags=ghci" - , builder GhcCabal ? crossCompiling ? arg "-f-terminfo" ] + , builder (GhcCabal Conf) ? ghcWithInterpreter ? notStage0 ? arg "--flags=ghci" + , builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" ] diff --git a/src/Settings/Packages/GhcPkg.hs b/src/Settings/Packages/GhcPkg.hs index a13a9dab7e..586d67243e 100644 --- a/src/Settings/Packages/GhcPkg.hs +++ b/src/Settings/Packages/GhcPkg.hs @@ -4,4 +4,4 @@ import Expression import Oracles.Flag (crossCompiling) ghcPkgPackageArgs :: Args -ghcPkgPackageArgs = package ghcPkg ? builder GhcCabal ? crossCompiling ? arg "-f-terminfo" +ghcPkgPackageArgs = package ghcPkg ? builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" diff --git a/src/Settings/Packages/GhcPrim.hs b/src/Settings/Packages/GhcPrim.hs index df1c553d25..86d72f5a8e 100644 --- a/src/Settings/Packages/GhcPrim.hs +++ b/src/Settings/Packages/GhcPrim.hs @@ -5,7 +5,7 @@ import Expression ghcPrimPackageArgs :: Args ghcPrimPackageArgs = package ghcPrim ? mconcat - [ builder GhcCabal ? arg "--flag=include-ghc-prim" + [ builder (GhcCabal Conf) ? arg "--flag=include-ghc-prim" , builder (Cc CompileC) ? (not <$> flag GccLt44) ? diff --git a/src/Settings/Packages/Ghci.hs b/src/Settings/Packages/Ghci.hs index 47e7d38deb..fa25d2a529 100644 --- a/src/Settings/Packages/Ghci.hs +++ b/src/Settings/Packages/Ghci.hs @@ -3,4 +3,4 @@ module Settings.Packages.Ghci (ghciPackageArgs) where import Expression ghciPackageArgs :: Args -ghciPackageArgs = package ghci ? notStage0 ? builder GhcCabal ? arg "--flags=ghci" +ghciPackageArgs = package ghci ? notStage0 ? builder (GhcCabal Conf) ? arg "--flags=ghci" diff --git a/src/Settings/Packages/Haddock.hs b/src/Settings/Packages/Haddock.hs index c8d667ecb4..3b2ad9229b 100644 --- a/src/Settings/Packages/Haddock.hs +++ b/src/Settings/Packages/Haddock.hs @@ -4,4 +4,4 @@ import Expression haddockPackageArgs :: Args haddockPackageArgs = package haddock ? - builder GhcCabal ? pure ["--flag", "in-ghc-tree"] + builder (GhcCabal Conf) ? pure ["--flag", "in-ghc-tree"] diff --git a/src/Settings/Packages/Haskeline.hs b/src/Settings/Packages/Haskeline.hs index 254c6b704c..ca2a561fe2 100644 --- a/src/Settings/Packages/Haskeline.hs +++ b/src/Settings/Packages/Haskeline.hs @@ -5,4 +5,4 @@ import Oracles.Flag (crossCompiling) haskelinePackageArgs :: Args haskelinePackageArgs = - package haskeline ? builder GhcCabal ? crossCompiling ? arg "-f-terminfo" + package haskeline ? builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" diff --git a/src/Settings/Packages/IntegerGmp.hs b/src/Settings/Packages/IntegerGmp.hs index 7c2b5f635b..8cc53426ca 100644 --- a/src/Settings/Packages/IntegerGmp.hs +++ b/src/Settings/Packages/IntegerGmp.hs @@ -17,7 +17,7 @@ integerGmpPackageArgs = package integerGmp ? do gmpLibDir <- getSetting GmpLibDir mconcat [ builder Cc ? arg includeGmp - , builder GhcCabal ? mconcat + , builder (GhcCabal Conf) ? mconcat [ (null gmpIncludeDir && null gmpLibDir) ? arg "--configure-option=--with-intree-gmp" , arg ("--configure-option=CFLAGS=" ++ includeGmp) From 8ba790d7562808119b3ad091b59b961e2c05a743 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 21:20:59 +0800 Subject: [PATCH 022/210] contextInstallDir is libDir --- src/Context.hs | 12 ++++++------ src/Rules/Library.hs | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index 362d233ba0..4687600f26 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -8,7 +8,7 @@ module Context ( -- * Paths buildDir, contextPath, getContextPath, - contextDir, contextInstallDir, buildPath, pkgInplaceConfig, pkgDataFile, + contextDir, libDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile, pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile, pkgConfFile, objectPath, pkgId ) where @@ -95,17 +95,17 @@ pkgId package = case pkgCabalFile package of Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts -- | The directroy in 'buildRoot' that will hold the final install artifact for a given 'Context'. -contextInstallDir :: Context -> FilePath -contextInstallDir Context {..} = stageString stage -/- "lib" +libDir :: Context -> FilePath +libDir Context {..} = stageString stage -/- "lib" -- | Path to the directory containg the final artifact in a given 'Context' -installPath :: Context -> Action FilePath -installPath context = buildRoot <&> (-/- contextInstallDir context) +libPath :: Context -> Action FilePath +libPath context = buildRoot <&> (-/- libDir context) pkgFile :: Context -> String -> String -> Action FilePath pkgFile context@Context {..} prefix suffix = do - path <- installPath context + path <- libPath context pid <- pkgId package return $ path -/- prefix ++ pid ++ suffix diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 29758ce627..02627b51a5 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -83,7 +83,7 @@ buildPackageLibrary context@Context {..} = do unless isLib0 . putSuccess $ renderLibrary (quote (pkgName package) ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") a synopsis - let instPrefix = "//" ++ contextInstallDir context -/- "libHS" ++ pkgId + let instPrefix = "//" ++ libDir context -/- "libHS" ++ pkgId instArchive = instPrefix ++ (waySuffix way <.> "a") instArchive %%> \a -> do From 6977e5f305e3f94fd654566abbdda1f0e5c05245 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 21:21:24 +0800 Subject: [PATCH 023/210] [libraries] proper pkgid --- src/Rules/Library.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 02627b51a5..883ed5fdf4 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -45,8 +45,7 @@ buildDynamicLib context@Context{..} = do else Cabal.name cabal ++ "-" ++ version cabal Nothing -> return (pkgName package) - -- let libPrefix = "//" ++ contextInstallDir context -/- "libHS" ++ pkgId - let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgName package + let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgId -- OS X libPrefix ++ "*.dylib" %> buildDynamicLibUnix -- Linux @@ -93,7 +92,15 @@ buildPackageLibrary context@Context {..} = do buildPackageGhciLibrary :: Context -> Rules () buildPackageGhciLibrary context@Context {..} = priority 2 $ do - let libPrefix = "//" ++ contextDir context -/- "HS" ++ pkgName package + pkgId <- case pkgCabalFile package of + Just file -> do + cabal <- liftIO $ parseCabal file + return $ if (null $ version cabal) + then Cabal.name cabal + else Cabal.name cabal ++ "-" ++ version cabal + Nothing -> return (pkgName package) + + let libPrefix = "//" ++ buildDir context -/- "HS" ++ pkgId o = libPrefix ++ "*" ++ (waySuffix way <.> "o") o %> \obj -> do objs <- allObjects context From e09671045a9644931d1f80dd88367a0fa04d29c6 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 23:15:32 +0800 Subject: [PATCH 024/210] [pkg-db] unify naming. --- src/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Base.hs b/src/Base.hs index 49328a4dbd..331b9c2d0a 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -77,7 +77,7 @@ generatedDir = "generated" -- | The directory in 'buildRoot' containing the 'Stage0' package database. stage0PackageDbDir :: FilePath -stage0PackageDbDir = "stage0/lib/bootstrapping.conf" +stage0PackageDbDir = "stage0/lib/package.conf.d" -- | Path to the inplace package database used in 'Stage1' and later. inplacePackageDbPath :: Stage -> FilePath From 966e0c2112d30313ec6d3d2c34b0a59e414b0a4a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 23:15:54 +0800 Subject: [PATCH 025/210] [ghc-cabal] rules for copy and register --- src/Settings/Builders/GhcCabal.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index b06b206dd4..baf419d1ab 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -9,7 +9,8 @@ import Flavour import Settings.Builders.Common ghcCabalBuilderArgs :: Args -ghcCabalBuilderArgs = builder (GhcCabal Conf) ? do +ghcCabalBuilderArgs = mconcat + [ builder (GhcCabal Conf) ? do verbosity <- expr getVerbosity top <- expr topDirectory path <- getContextPath @@ -30,6 +31,16 @@ ghcCabalBuilderArgs = builder (GhcCabal Conf) ? do , with Happy , verbosity < Chatty ? pure [ "-v0", "--configure-option=--quiet" , "--configure-option=--disable-option-checking" ] ] + , builder (GhcCabal Copy) ? do + verbosity <- expr getVerbosity + mconcat [ arg "copy" + , getInputs + ] + , builder (GhcCabal Reg) ? do + mconcat [ arg "register" + , getInputs + ] + ] -- TODO: Isn't vanilla always built? If yes, some conditions are redundant. -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci? From 74427878893efe8b6f180862fabe0a75f6587e0e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 23:16:05 +0800 Subject: [PATCH 026/210] Paths --- src/Context.hs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index 4687600f26..d04e80cd3f 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -7,8 +7,8 @@ module Context ( withHsPackage, -- * Paths - buildDir, contextPath, getContextPath, - contextDir, libDir, buildPath, pkgInplaceConfig, pkgDataFile, + stageDir, stagePath, getStagePath, buildDir, contextPath, getContextPath, + contextDir, libDir, libPath, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile, pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile, pkgConfFile, objectPath, pkgId ) where @@ -66,6 +66,17 @@ withHsPackage expr = do Just file -> expr file Nothing -> mempty +-- | 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 artefacts of a given 'Context'. contextDir :: Context -> FilePath contextDir Context {..} = stageString stage -/- pkgPath package @@ -107,7 +118,7 @@ pkgFile :: Context -> String -> String -> Action FilePath pkgFile context@Context {..} prefix suffix = do path <- libPath context pid <- pkgId package - return $ path -/- prefix ++ pid ++ suffix + return $ path -/- pid -/- prefix ++ pid ++ suffix -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath From 361f4b62d320f196342d9a4a286500120459829d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 23:16:43 +0800 Subject: [PATCH 027/210] Use the ghc-cabal from the next stage. E.g. buld ghc-cabal with stage0, it's part of the stage1 then. --- src/Builder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Builder.hs b/src/Builder.hs index 13de782592..b60f7abcec 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -139,7 +139,7 @@ builderProvenance = \case GenPrimopCode -> context Stage1 genprimopcode Ghc _ Stage0 -> Nothing Ghc _ stage -> context stage ghc - GhcCabal _ stage -> context stage ghcCabal + GhcCabal _ stage -> context (succ stage) ghcCabal GhcPkg _ Stage0 -> Nothing GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock From d2a283313d20ac683f6d7fb4d9b686dc7119a0af Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 27 Oct 2017 23:16:53 +0800 Subject: [PATCH 028/210] copy and register library logic --- src/Rules/Library.hs | 67 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 61 insertions(+), 6 deletions(-) diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 883ed5fdf4..f7599cfda0 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -18,6 +18,66 @@ import Settings import Target import Utilities +archive :: Way -> String -> String +archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") + +pkgObject :: Way -> String -> String +pkgObject way pkgId = "HS" ++ pkgId ++ (waySuffix way <.> "o") + +-- | Building a library consist of building +-- the artefacts, 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 lirbary artifacts. +library :: Context -> Rules () +library context@Context{..} = do + pkgId <- case pkgCabalFile package of + Just file -> do + cabal <- liftIO $ parseCabal file + return $ if (null $ version cabal) + then Cabal.name cabal + else Cabal.name cabal ++ "-" ++ version cabal + Nothing -> return (pkgName package) + + "//" ++ libDir context -/- pkgId -/- archive way pkgId %> \a -> do + -- ghc-cabal copy libraries/terminfo $PWD/_build/stage0/libraries/terminfo : $PWD/_build/stage1 "" "lib" "share" "v" + -- ghc-cabal register libraries/terminfo $PWD/_build/stage0/libraries/terminfo ghc ghc-pkg $PWD/_build/stage1/lib $PWD/_build_stage1 "" "lib" "share" YES + _a <- buildPath context <&> (-/- archive way pkgId) + _o <- buildPath context <&> (-/- pkgObject way pkgId) + + need [_a, _o] + + -- might need some package-db resource to limit read/write, + -- see packageRules + top <- topDirectory + ctxPath <- (top -/-) <$> contextPath context + stgPath <- (top -/-) <$> stagePath context + libPath <- (top -/-) <$> libPath context + build $ target context (GhcCabal Copy stage) [ "libraries" -/- (pkgName package) -- + , ctxPath -- + , ":" -- no strip. ':' special marker + , stgPath -- + , "" -- + , "lib" -- + , "share" -- + , "v" -- TODO: e.g. "v dyn" for dyn way. + ] [] + build $ target context (GhcCabal Reg stage) [ "libraries" -/- (pkgName package) + , ctxPath + , "ghc" -- TODO: path to staged ghc. + , "ghc-pkg" -- TODO: path to staged ghc-pkg. + , libPath + , stgPath + , "" + , "lib" + , "share" + , "YES" -- + ] [a] + libraryObjects :: Context -> Action [FilePath] libraryObjects context@Context{..} = do hsObjs <- hsObjects context @@ -82,13 +142,8 @@ buildPackageLibrary context@Context {..} = do unless isLib0 . putSuccess $ renderLibrary (quote (pkgName package) ++ " (" ++ show stage ++ ", way " ++ show way ++ ").") a synopsis - let instPrefix = "//" ++ libDir context -/- "libHS" ++ pkgId - instArchive = instPrefix ++ (waySuffix way <.> "a") - instArchive %%> \a -> do - archive <- buildRoot <&> (-/- (buildDir context -/- "libHS" ++ pkgId ++ (waySuffix way <.> "a"))) - need [archive] - -- TODO: ghc-cabal copy; register + library context buildPackageGhciLibrary :: Context -> Rules () buildPackageGhciLibrary context@Context {..} = priority 2 $ do From 7b384808de72482f89aed47fc4b501c62a794713 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 28 Oct 2017 09:30:51 +0800 Subject: [PATCH 029/210] [ghc-pkg] Add clone (describe + register) logic. --- src/Builder.hs | 7 ++++++- src/Settings/Builders/GhcPkg.hs | 8 +++++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index b60f7abcec..e3221b5d6b 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -60,7 +60,7 @@ 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 | Update | Clone deriving (Eq, Generic, Show) instance Binary GhcPkgMode instance Hashable GhcPkgMode @@ -213,6 +213,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, diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs index 2c78846cb9..3f8bec07e2 100644 --- a/src/Settings/Builders/GhcPkg.hs +++ b/src/Settings/Builders/GhcPkg.hs @@ -5,7 +5,13 @@ 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" ] , builder (GhcPkg Update) ? do verbosity <- expr getVerbosity context <- getContext From afb84ba60a983d8087cdee3d191aa24a63862088 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 28 Oct 2017 17:32:45 +0800 Subject: [PATCH 030/210] Logic for asking builders. --- src/Builder.hs | 14 +++++++++++++- src/Hadrian/Builder.hs | 20 ++++++++++++++++---- src/Utilities.hs | 5 ++++- 3 files changed, 33 insertions(+), 6 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index e3221b5d6b..7104d50110 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -60,7 +60,7 @@ instance Hashable GhcCabalMode instance NFData GhcCabalMode -- | GhcPkg can initialise a package database and register packages in it. -data GhcPkgMode = Init | Update | Clone deriving (Eq, Generic, Show) +data GhcPkgMode = Init | Update | Clone | Dependencies deriving (Eq, Generic, Show) instance Binary GhcPkgMode instance Hashable GhcPkgMode @@ -165,6 +165,18 @@ instance H.Builder Builder where Make dir -> need [dir -/- "Makefile"] _ -> when (isJust $ builderProvenance builder) $ need [path] + 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"] + -- this is a hack. + return $ drop 1 $ concatMap words (lines stdout) + runBuilderWith :: Builder -> BuildInfo -> Action () runBuilderWith builder BuildInfo {..} = do path <- builderPath builder diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs index 6cc53ef06d..2d77c0f911 100644 --- a/src/Hadrian/Builder.hs +++ b/src/Hadrian/Builder.hs @@ -14,7 +14,7 @@ module Hadrian.Builder ( Builder (..), BuildInfo (..), runBuilder, runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions, getBuilderPath, - builderEnvironment + builderEnvironment, askWithResources ) where import Data.List @@ -42,6 +42,9 @@ class ShakeValue b => Builder b where -- | The path to a builder. builderPath :: b -> Action FilePath + -- | Ask the builder for something + askBuilderWith :: b -> BuildInfo -> Action [String] -- TODO: this better be `a`, and the builder decides? + -- | Make sure a builder exists and rebuild it if out of date. needBuilder :: b -> Action () needBuilder builder = do @@ -83,12 +86,15 @@ 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) -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a +doWith f rs opts target args = do needBuilder (builder target) argList <- interpret target args trackArgsHash target -- Rerun the rule if the hash of argList has changed. @@ -96,13 +102,19 @@ buildWith rs opts target args = do verbose <- interpret target verboseCommand let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly quietlyUnlessVerbose $ do - runBuilderWith (builder target) $ BuildInfo + 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 + +askWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action [String] +askWith = doWith askBuilderWith + -- | Print out information about the command being executed. putInfo :: Show b => Target c b -> Action () putInfo t = putProgressInfo =<< renderAction diff --git a/src/Utilities.hs b/src/Utilities.hs index 3c61daecfd..93a38cbf82 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -1,7 +1,7 @@ module Utilities ( build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith, needLibrary, contextDependencies, stage1Dependencies, libraryTargets, - topsortPackages + topsortPackages, askWithResources ) where import qualified Hadrian.Builder as H @@ -24,6 +24,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 + -- | Given a 'Context' this 'Action' look up the package dependencies and wrap -- the results in appropriate contexts. The only subtlety here is that we never -- depend on packages built in 'Stage2' or later, therefore the stage of the From fc3c06f0ddeb78c14c68a665c0fe01e92db941bf Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 28 Oct 2017 22:42:37 +0800 Subject: [PATCH 031/210] Prettify doWith --- src/Hadrian/Builder.hs | 26 +++++++++++++++++++------- src/Hadrian/Utilities.hs | 14 +++++++++++++- 2 files changed, 32 insertions(+), 8 deletions(-) diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs index 2d77c0f911..79a1c63cca 100644 --- a/src/Hadrian/Builder.hs +++ b/src/Hadrian/Builder.hs @@ -93,12 +93,15 @@ askWithResources rs = askWith rs [] buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action () buildWithCmdOptions = buildWith [] -doWith :: (Builder b, ShakeValue c) => (b -> BuildInfo -> Action a) -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a -doWith f 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 $ do @@ -110,14 +113,14 @@ doWith f rs opts target args = do , buildResources = rs } buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action () -buildWith = doWith runBuilderWith +buildWith = doWith runBuilderWith runInfo askWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action [String] -askWith = doWith askBuilderWith +askWith = doWith askBuilderWith askInfo -- | Print out information about the command being executed. -putInfo :: Show b => Target c b -> Action () -putInfo t = putProgressInfo =<< renderAction +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) @@ -126,6 +129,15 @@ putInfo t = putProgressInfo =<< renderAction 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/Utilities.hs b/src/Hadrian/Utilities.hs index 1cd22b1179..fb751fee53 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -22,7 +22,7 @@ module Hadrian.Utilities ( -- * Diagnostic info UseColour (..), putColoured, BuildProgressColour (..), putBuild, SuccessColour (..), putSuccess, ProgressInfo (..), - putProgressInfo, renderAction, renderProgram, renderLibrary, renderBox, + putProgressInfo, renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn, -- * Miscellaneous @@ -323,6 +323,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 $ From dbb69d9123822bab1d9fd3c64417dc2bbaab7424 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 28 Oct 2017 22:44:16 +0800 Subject: [PATCH 032/210] buildPath, not contextPath --- src/Rules/Compile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs index 82c0ac135e..3de226372a 100644 --- a/src/Rules/Compile.hs +++ b/src/Rules/Compile.hs @@ -78,6 +78,6 @@ obj2src extension isGenerated context@Context {..} obj where src = obj -<.> extension suffix = do - path <- contextPath context + path <- buildPath context return $ fromMaybe ("Cannot determine source for " ++ obj) $ stripPrefix (path -/- extension) src From 79dd24c275f42a4ea4e07be2a2483b0d69465d57 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 28 Oct 2017 22:45:27 +0800 Subject: [PATCH 033/210] Do NOT require the package config file when building said pacakge. --- src/Rules/Compile.hs | 1 - src/Settings/Builders/Ghc.hs | 5 ----- 2 files changed, 6 deletions(-) diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs index 3de226372a..91529b715e 100644 --- a/src/Rules/Compile.hs +++ b/src/Rules/Compile.hs @@ -22,7 +22,6 @@ compilePackage rs context@Context {..} = do path <- contextPath context (src, deps) <- lookupDependencies (path -/- ".dependencies") obj need $ src : deps - when (isLibrary package) $ need =<< return <$> pkgConfFile context needLibrary =<< contextDependencies context buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj] diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 94b5b211c1..ca8499b939 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -87,11 +87,6 @@ commonGhcArgs :: Args commonGhcArgs = do way <- getWay path <- getBuildPath - pkg <- getPackage - when (isLibrary pkg) $ do - context <- getContext - conf <- expr $ pkgConfFile context - expr $ need [conf] mconcat [ arg "-hisuf", arg $ hisuf way , arg "-osuf" , arg $ osuf way , arg "-hcsuf", arg $ hcsuf way From 91ad2d227fe9854b68178eb6ba0dad95bd1a5bed Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 28 Oct 2017 23:06:32 +0800 Subject: [PATCH 034/210] Fix build path --- src/Rules/Program.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 915b2f0af0..5d26446639 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -108,8 +108,8 @@ buildBinary rs bin context@Context {..} = do cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs - ++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ] - ++ [ path -/- "Paths_haddock.o" | package == haddock ] + ++ [ path -/- "build" -/- "Paths_hsc2hs.o" | package == hsc2hs ] + ++ [ path -/- "build" -/- "Paths_haddock.o" | package == haddock ] need binDeps buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin] synopsis <- traverse pkgSynopsis (pkgCabalFile package) From dfb361b7e56631774861c5bf9d0b2a2817b94e64 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 29 Oct 2017 14:41:48 +0800 Subject: [PATCH 035/210] [ghcversion.h] adds knowledge about ghcVersionH --- src/Base.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/Base.hs b/src/Base.hs index 331b9c2d0a..945dfe9264 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -18,9 +18,11 @@ module Base ( module Stage, module Way, + -- * Files + configH, ghcVersionH, -- * Paths - hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir, - generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, + hadrianPath, configPath, configFile, sourcePath, shakeFilesDir, + generatedDir, generatedPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, stageBinPath, stageLibPath, ghcDeps, templateHscPath, stage0PackageDbDir, inplacePackageDbPath, packageDbPath, packageDbStamp @@ -65,6 +67,9 @@ 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 @@ -75,6 +80,9 @@ shakeFilesDir = "hadrian" generatedDir :: FilePath generatedDir = "generated" +generatedPath :: Action FilePath +generatedPath = buildRoot <&> (-/- generatedDir) + -- | The directory in 'buildRoot' containing the 'Stage0' package database. stage0PackageDbDir :: FilePath stage0PackageDbDir = "stage0/lib/package.conf.d" From 93b6f2a691506eaf9d71dc4152f97a17729b075a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 29 Oct 2017 14:43:13 +0800 Subject: [PATCH 036/210] [rts] pass -ghc-version when building. --- src/Settings/Builders/Ghc.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index ca8499b939..ef19151b10 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -87,12 +87,22 @@ commonGhcArgs :: Args commonGhcArgs = do 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) ? arg ("-ghc-version=" ++ ghcVersion) , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getPkgDataList CppArgs From ae9742259b17fd8d1cbb4a07e518a34c0e99feda Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:45:35 +0800 Subject: [PATCH 037/210] [ghc-cabal] always stage1. --- src/Builder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Builder.hs b/src/Builder.hs index 7104d50110..17003be4a6 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -139,7 +139,7 @@ builderProvenance = \case GenPrimopCode -> context Stage1 genprimopcode Ghc _ Stage0 -> Nothing Ghc _ stage -> context stage ghc - GhcCabal _ stage -> context (succ stage) ghcCabal + GhcCabal _ _ -> context Stage1 ghcCabal GhcPkg _ Stage0 -> Nothing GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock From 256e1f312d4d982d7978fe34953545520a14adce Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:47:30 +0800 Subject: [PATCH 038/210] generated code in 'build/' dir. --- src/Oracles/ModuleFiles.hs | 2 +- src/Rules/Generate.hs | 11 +++++------ 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index d4a8ff2b3a..7ac790d84a 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -96,7 +96,7 @@ hsObjects context = do -- | Generated module files live in the 'Context' specific build directory. generatedFile :: Context -> String -> Action FilePath generatedFile context moduleName = do - path <- contextPath context + path <- buildPath context return $ path -/- moduleSource moduleName moduleSource :: String -> FilePath diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 9fb6189e29..20b7e2781b 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -24,8 +24,7 @@ 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 = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" @@ -44,8 +43,8 @@ includesDependencies = fmap (generatedDir -/-) ghcPrimDependencies :: Expr [FilePath] ghcPrimDependencies = do stage <- getStage - path <- expr $ contextPath (vanillaContext stage ghcPrim) - return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"] + path <- expr $ buildPath (vanillaContext stage ghcPrim) + return $ traceShowId [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"] derivedConstantsDependencies :: [FilePath] derivedConstantsDependencies = fmap (generatedDir -/-) @@ -59,7 +58,7 @@ compilerDependencies = do root <- getBuildRoot stage <- getStage intLib <- expr (integerLibrary =<< flavour) - ghcPath <- expr $ contextPath (vanillaContext stage compiler) + ghcPath <- expr $ buildPath (vanillaContext stage compiler) gmpPath <- expr gmpBuildPath rtsPath <- expr rtsBuildPath mconcat [ return [root -/- platformH stage] @@ -103,7 +102,7 @@ generate file context expr = do generatePackageCode :: Context -> Rules () generatePackageCode context@(Context stage pkg _) = - let dir = contextDir context + let dir = buildDir context generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f) go gen file = generate file context gen in do From a05791b0ece5330856eaee1359dd04c1b2400cc1 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:48:05 +0800 Subject: [PATCH 039/210] [ghc-prim] GHC.Prim Rules only for the prim package. --- src/Rules/Generate.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 20b7e2781b..b33c455f0c 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -129,7 +129,8 @@ generatePackageCode context@(Context stage pkg _) = "//" ++ platformH stage %> go generateGhcBootPlatformH -- TODO: why different folders for generated files? - priority 2.0 $ fmap (("//" ++ dir) -/-) + when (pkg == ghcPrim) $ do + priority 2.0 $ fmap (("//" ++ dir) -/-) [ "GHC/Prim.hs" , "GHC/PrimopWrappers.hs" , "*.hs-incl" ] |%> \file -> do From 3ade23d68edc429246ec99c5afcd8015dce5a362 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:49:48 +0800 Subject: [PATCH 040/210] PlatformH logic. --- src/Rules/Generate.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index b33c455f0c..6fdaa31cde 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -25,6 +25,27 @@ primopsSource = "compiler/prelude/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" + +-- TODO: FIXME: Add 'headers' to the ghc.cabal's include-dirs +-- and palce ghc_boot_platform.h and HsVersions.h into 'headers'. +-- But "HsVersion.h" lives in compiler/ right now +-- +-- Why do we need to hardcode the path into the source? +-- The reason is that ghc-cabal, is pointed to `compiler`, and reads +-- the ghc.cabal file there. It then tries to resolve files relative +-- to the include-dirs, which are again relative to `compiler`, not +-- the _build/stageN/compiler directory. +-- +-- However, ghc-cabal, looks for interfaces relative to the build directory. +-- As such I would argue, it should also look for headers and others relative +-- to the build directory. This might incure the need to copy over the HsVersion.h +-- into the build directory. +-- +-- TODO: Also ensure that the includes in the source files match. E.g. provide +-- the relevant -I flags to the invocation. +-- +-- NOTE: We *hardcode* the inplace path, at the same point where we generate the +-- staged ones. platformH :: Stage -> FilePath platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" @@ -126,6 +147,10 @@ generatePackageCode context@(Context stage pkg _) = ++ 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 + "//compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH "//" ++ platformH stage %> go generateGhcBootPlatformH -- TODO: why different folders for generated files? From f49ab6cc6612827d778b3436918e04be83aa6a28 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:51:39 +0800 Subject: [PATCH 041/210] [rts] it's a package. --- src/Hadrian/Package.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Hadrian/Package.hs b/src/Hadrian/Package.hs index c7dc525729..002f88e02d 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -104,6 +104,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@, From d26a5b62004c2931b0990f4c06b753bada185eab Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:52:09 +0800 Subject: [PATCH 042/210] Register and copy logic. --- src/Rules/Library.hs | 35 +------------ src/Rules/Register.hs | 115 +++++++++++++++++++++++++++++++++++++++--- src/Utilities.hs | 5 +- 3 files changed, 115 insertions(+), 40 deletions(-) diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index f7599cfda0..3528dba006 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -44,39 +44,8 @@ library context@Context{..} = do Nothing -> return (pkgName package) "//" ++ libDir context -/- pkgId -/- archive way pkgId %> \a -> do - -- ghc-cabal copy libraries/terminfo $PWD/_build/stage0/libraries/terminfo : $PWD/_build/stage1 "" "lib" "share" "v" - -- ghc-cabal register libraries/terminfo $PWD/_build/stage0/libraries/terminfo ghc ghc-pkg $PWD/_build/stage1/lib $PWD/_build_stage1 "" "lib" "share" YES - _a <- buildPath context <&> (-/- archive way pkgId) - _o <- buildPath context <&> (-/- pkgObject way pkgId) - - need [_a, _o] - - -- might need some package-db resource to limit read/write, - -- see packageRules - top <- topDirectory - ctxPath <- (top -/-) <$> contextPath context - stgPath <- (top -/-) <$> stagePath context - libPath <- (top -/-) <$> libPath context - build $ target context (GhcCabal Copy stage) [ "libraries" -/- (pkgName package) -- - , ctxPath -- - , ":" -- no strip. ':' special marker - , stgPath -- - , "" -- - , "lib" -- - , "share" -- - , "v" -- TODO: e.g. "v dyn" for dyn way. - ] [] - build $ target context (GhcCabal Reg stage) [ "libraries" -/- (pkgName package) - , ctxPath - , "ghc" -- TODO: path to staged ghc. - , "ghc-pkg" -- TODO: path to staged ghc-pkg. - , libPath - , stgPath - , "" - , "lib" - , "share" - , "YES" -- - ] [a] + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId] + return () libraryObjects :: Context -> Action [FilePath] libraryObjects context@Context{..} = do diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 14be2b121b..d5a69f0d3a 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -1,38 +1,141 @@ -module Rules.Register (registerPackage) where +{-# LANGUAGE TupleSections #-} +module Rules.Register (copyBootPackages, registerPackage) where import Base import Context import GHC import Target import Utilities +import Oracles.Setting + +import Distribution.ParseUtils +import qualified Distribution.Compat.ReadP as Parse +import Distribution.Version (Version) + +import Hadrian.Haskell.Cabal.Parse as Cabal + +parseCabalName :: String -> Maybe (String, Version) +parseCabalName = readPToMaybe parse + where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion + +-- | This rule provides rules for copying packges into the +-- boot packages db from the installed compiler. +copyBootPackages :: [(Resource, Int)] -> Context -> Rules () +copyBootPackages rs context@Context {..} = do + "//" ++ stage0PackageDbDir -/- "*.conf" %> copyConf rs context -- TODO: Simplify. -- | 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 + pkgId <- case pkgCabalFile package of + Just file -> do + cabal <- liftIO $ parseCabal file + return $ if (null $ version cabal) + then Cabal.name cabal + else Cabal.name cabal ++ "-" ++ version cabal + Nothing -> return (pkgName package) + + -- 'rts' has no version. As such we should never generate a rule for the + -- rts in stage0. The rts is also not expected to be built for stage0. + -- We intend to copy over the pkg from the bootstrap compiler. + -- + -- This usually works if packges have - identifier. As + -- dependencies will pick from the bootstrap compiler as needed. For + -- packages without version though, this results duplicated rules for + -- the copyBootPackage and the packge. + -- + -- TODO: HACK + -- This should really come from the flavour's packages. But those are + -- currently not available at rule time... + let bootpackages = [ binary, text, transformers, mtl, parsec, cabal, hpc + , ghcBootTh, ghcBoot, templateHaskell, compiler, ghci + , terminfo -- TODO: only if Windows_HOST == NO + ] + when (stage == Stage0 && package `elem` bootpackages) $ 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" %%> + "//" ++ stage0PackageDbDir -/- pkgId ++ ".conf" %%> buildConf rs context - when (package == ghc) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %> + -- This is hack. This check is only here so we build it at most once. + when (package == binary) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %> buildStamp rs context when (stage == Stage1) $ do - "//" ++ inplacePackageDbPath stage -/- pkgName package ++ "*.conf" %%> + "//" ++ inplacePackageDbPath stage -/- pkgId ++ ".conf" %%> buildConf rs context when (package == ghc) $ "//" ++ inplacePackageDbPath stage -/- packageDbStamp %> buildStamp rs context +copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action () +copyConf rs context@Context {..} conf = do + let Just pkgName | takeBaseName conf == "rts" = Just "rts" + | otherwise = fst <$> parseCabalName (takeBaseName conf) + depPkgIds <- askWithResources rs $ + target context (GhcPkg Dependencies stage) [pkgName] [] + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds + buildWithResources rs $ do + target context (GhcPkg Clone stage) [pkgName] [conf] + +archive :: Way -> String -> String +archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") + +pkgObject :: Way -> String -> String +pkgObject way pkgId = "HS" ++ pkgId ++ (waySuffix way <.> "o") + buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () buildConf rs context@Context {..} conf = do + pkgId <- case pkgCabalFile package of + Just file -> do + cabal <- liftIO $ parseCabal file + return $ if (null $ version cabal) + then Cabal.name cabal + else Cabal.name cabal ++ "-" ++ version cabal + Nothing -> return (pkgName package) + + depPkgIds <- cabalDependencies context confIn <- pkgInplaceConfig context need [confIn] - buildWithResources rs $ target context (GhcPkg Update stage) [confIn] [conf] + + need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds + + -- ghc-cabal copy libraries/terminfo $PWD/_build/stage0/libraries/terminfo : $PWD/_build/stage1 "" "lib" "share" "v" + -- ghc-cabal register libraries/terminfo $PWD/_build/stage0/libraries/terminfo ghc ghc-pkg $PWD/_build/stage1/lib $PWD/_build_stage1 "" "lib" "share" YES + _a <- buildPath context <&> (-/- archive way pkgId) + _o <- buildPath context <&> (-/- pkgObject way pkgId) + + need [_a, _o] + + -- might need some package-db resource to limit read/write, + -- see packageRules + top <- topDirectory + ctxPath <- (top -/-) <$> contextPath context + stgPath <- (top -/-) <$> stagePath context + libPath <- (top -/-) <$> libPath context + build $ target context (GhcCabal Copy stage) [ (pkgPath package) -- + , ctxPath -- + , ":" -- no strip. ':' special marker + , stgPath -- + , "" -- + , "lib" -- + , "share" -- + , "v" -- TODO: e.g. "v dyn" for dyn way. + ] [] + build $ target context (GhcCabal Reg stage) [ (pkgPath package) + , ctxPath + , "ghc" -- TODO: path to staged ghc. + , "ghc-pkg" -- TODO: path to staged ghc-pkg. + , libPath + , stgPath + , "" + , libPath + , "share" + , if stage == Stage0 then "NO" else "YES" -- + ] [conf] buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action () buildStamp rs Context {..} stamp = do diff --git a/src/Utilities.hs b/src/Utilities.hs index 93a38cbf82..9385810d5d 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -1,7 +1,7 @@ module Utilities ( build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith, needLibrary, contextDependencies, stage1Dependencies, libraryTargets, - topsortPackages, askWithResources + topsortPackages, askWithResources, cabalDependencies ) where import qualified Hadrian.Builder as H @@ -43,6 +43,9 @@ contextDependencies Context {..} = case pkgCabalFile package of pkgs <- sort <$> stagePackages depStage return . map depContext $ intersectOrd (compare . pkgName) pkgs deps +cabalDependencies :: Context -> Action [String] +cabalDependencies ctx = interpretInContext ctx $ getPkgDataList DepIds + -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context. stage1Dependencies :: Package -> Action [Package] stage1Dependencies = From 97c60bc99cab1e799a4a4bb07879fba230e3921f Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:52:19 +0800 Subject: [PATCH 043/210] Adds copyBootPackages logic. --- src/Rules.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Rules.hs b/src/Rules.hs index cf22caa890..e3c812f92c 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -99,6 +99,8 @@ packageRules = do forM_ (filter isProgram knownPackages) $ Rules.Program.buildProgram readPackageDb + Rules.Register.copyBootPackages writePackageDb (Context Stage0 base vanilla) -- base is only a dummy here. + forM_ vanillaContexts $ mconcat [ Rules.PackageData.buildPackageData , Rules.Dependencies.buildPackageDependencies readPackageDb From 1067d26e6473dd81ae6f71766d3be0f2f582c96c Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 09:54:03 +0800 Subject: [PATCH 044/210] Drop trace. --- src/Rules/Generate.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 6fdaa31cde..12c999d37c 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -65,7 +65,7 @@ ghcPrimDependencies :: Expr [FilePath] ghcPrimDependencies = do stage <- getStage path <- expr $ buildPath (vanillaContext stage ghcPrim) - return $ traceShowId [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"] + return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"] derivedConstantsDependencies :: [FilePath] derivedConstantsDependencies = fmap (generatedDir -/-) From cfaf8ead031d321b2cafb4e6f869af580e7e04ef Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 10:32:43 +0800 Subject: [PATCH 045/210] Fix hsc2hs to stage1 --- src/Builder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Builder.hs b/src/Builder.hs index 17003be4a6..cbc48d2e92 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -144,7 +144,7 @@ builderProvenance = \case GhcPkg _ _ -> context Stage1 ghcPkg Haddock _ -> context Stage2 haddock Hpc -> context Stage1 hpcBin - Hsc2Hs stage -> context (succ stage) hsc2hs + Hsc2Hs stage -> context Stage1 hsc2hs Unlit -> context Stage1 unlit _ -> Nothing where From 54ed0e436b12213ad34908f23a2a0a6cfa473225 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 10:33:01 +0800 Subject: [PATCH 046/210] Split .dependencies and .dependencies.mk rule --- src/Rules/Dependencies.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs index 4ac21a6a6f..515e1ff429 100644 --- a/src/Rules/Dependencies.hs +++ b/src/Rules/Dependencies.hs @@ -12,18 +12,20 @@ import Target import Utilities buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules () -buildPackageDependencies rs context@Context {..} = - "//" ++ contextDir context -/- ".dependencies" %> \deps -> do +buildPackageDependencies rs context@Context {..} = do + "//" ++ contextDir context -/- ".dependencies.mk" %> \mk -> do srcs <- hsSources context need srcs orderOnly =<< interpretInContext context generatedDependencies - let mk = deps <.> "mk" if srcs == [] then writeFileChanged mk "" else buildWithResources rs $ target context (Ghc FindHsDependencies stage) srcs [mk] removeFile $ mk <.> "bak" - mkDeps <- readFile' mk + + "//" ++ 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)) From 9cc50924cf6864ff97eff43c859ce1f97a101d85 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 10:33:38 +0800 Subject: [PATCH 047/210] [ghc-cabal - register] Add staged ghc / ghc-pkg --- src/Rules/Register.hs | 7 ++----- src/Settings/Builders/GhcCabal.hs | 21 +++++++++++++++++++-- 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index d5a69f0d3a..1e3e5ac772 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -125,11 +125,8 @@ buildConf rs context@Context {..} conf = do , "share" -- , "v" -- TODO: e.g. "v dyn" for dyn way. ] [] - build $ target context (GhcCabal Reg stage) [ (pkgPath package) - , ctxPath - , "ghc" -- TODO: path to staged ghc. - , "ghc-pkg" -- TODO: path to staged ghc-pkg. - , libPath + build $ target context (GhcCabal Reg stage) [ -- are provided by the ghcCabalBuilderArgs + libPath , stgPath , "" , libPath diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index baf419d1ab..2f4afbe8f6 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -37,10 +37,17 @@ ghcCabalBuilderArgs = mconcat , getInputs ] , builder (GhcCabal Reg) ? do + top <- expr topDirectory + path <- getContextPath + stage <- getStage 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? @@ -124,6 +131,7 @@ withBuilderArgs b = case b of 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 @@ -137,3 +145,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) From e1321aceddeb0b23bd993c78b38bbc01e907558b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 11:06:28 +0800 Subject: [PATCH 048/210] Oops. --- src/Settings/Builders/GhcCabal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 2f4afbe8f6..f8db52ea98 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -20,6 +20,7 @@ ghcCabalBuilderArgs = mconcat , arg $ top -/- path , withStaged $ Ghc CompileHs , withStaged (GhcPkg Update) + , withBuilderArgs (GhcPkg Update stage) , bootPackageDatabaseArgs , libraryArgs , configureArgs @@ -140,7 +141,6 @@ with b = do top <- expr topDirectory expr $ needBuilder b arg $ withBuilderKey b ++ unifyPath (top path) - withBuilderArgs b withStaged :: (Stage -> Builder) -> Args withStaged sb = with . sb =<< getStage From 926ff3a17060d2bc281abde95b15cd16c955a83e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 11:06:45 +0800 Subject: [PATCH 049/210] [genprimop] cleanup. --- src/Rules/Generate.hs | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 12c999d37c..b285720e97 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -136,7 +136,10 @@ generatePackageCode context@(Context stage pkg _) = whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot" priority 2.0 $ do - when (pkg == compiler) $ "//" -/- dir -/- "Config.hs" %> go generateConfigHs + when (pkg == compiler) $ do "//" -/- dir -/- "Config.hs" %> go generateConfigHs + "//" ++ dir -/- "*.hs-incl" %> genPrimopCode context + when (pkg == ghcPrim) $ do ("//" ++ dir -/- "GHC/Prim.hs") %> genPrimopCode context + ("//" ++ dir -/- "GHC/PrimopWrappers.hs") %> genPrimopCode context when (pkg == ghcPkg) $ "//" -/- dir -/- "Version.hs" %> go generateVersionHs -- TODO: needing platformH is ugly and fragile @@ -153,19 +156,15 @@ generatePackageCode context@(Context stage pkg _) = "//compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH "//" ++ platformH stage %> go generateGhcBootPlatformH - -- TODO: why different folders for generated files? - when (pkg == ghcPrim) $ do - 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] +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 forM_ [Stage0 ..] $ \stage -> do From 8559f257cd0b1e6dc314a56477ef44a5e6939945 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 11:41:57 +0800 Subject: [PATCH 050/210] `-ghc-version`, only with stage1 and later. The "already" installed ghc, will likely have the rts to consult. And `-ghc-version` requires GHC 8.4 or later at least. --- src/Settings/Builders/Ghc.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index ef19151b10..95ea793249 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -102,7 +102,7 @@ commonGhcArgs = do -- file, to prevent ghc from trying to open the -- rts package from the package db, and failing -- over while doing so. - , (pkg == rts) ? arg ("-ghc-version=" ++ ghcVersion) + , (pkg == rts) ? notStage0 ? arg ("-ghc-version=" ++ ghcVersion) , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getPkgDataList CppArgs From 2ba1ef1b38aa35c65116c848827d6794897a2453 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 15:42:23 +0800 Subject: [PATCH 051/210] More ask logic for builders. Now we can interrogate ghc for it's `--info` as well. --- src/Builder.hs | 22 ++++++++++++++++++---- src/Hadrian/Builder.hs | 11 +++++++---- src/Rules/Register.hs | 6 +++++- src/Settings/Default.hs | 2 +- src/Utilities.hs | 7 +++++-- 5 files changed, 36 insertions(+), 12 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index cbc48d2e92..c3d093a063 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -44,7 +44,7 @@ instance NFData CcMode -- * Compile a C source file. -- * Extract source dependencies by passing @-M@ command line argument. -- * Link object files & static libraries into an executable. -data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs +data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs deriving (Eq, Generic, Show) instance Binary GhcMode @@ -165,8 +165,23 @@ instance H.Builder Builder where Make dir -> need [dir -/- "Makefile"] _ -> when (isJust $ builderProvenance builder) $ need [path] - askBuilderWith :: Builder -> BuildInfo -> Action [String] + -- TODO: We would need to encode that asking a builder, + -- depending on the "ask" mode, has different return types. + -- For now it's the stdout string. + -- + -- This however means that the string -> datatype logic + -- needs to reside at the callsite. + askBuilderWith :: Builder -> BuildInfo -> Action String askBuilderWith builder BuildInfo {..} = case builder of + Ghc Settings _ -> 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] ["--info"] + return stdout + GhcPkg Dependencies _ -> do let input = fromSingleton msgIn buildInputs msgIn = "[askBuilder] Exactly one input file expected." @@ -174,8 +189,7 @@ instance H.Builder Builder where path <- H.builderPath builder need [path] Stdout stdout <- cmd [path] ["--no-user-package-db", "field", input, "depends"] - -- this is a hack. - return $ drop 1 $ concatMap words (lines stdout) + return stdout runBuilderWith :: Builder -> BuildInfo -> Action () runBuilderWith builder BuildInfo {..} = do diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs index 79a1c63cca..af0a1b4690 100644 --- a/src/Hadrian/Builder.hs +++ b/src/Hadrian/Builder.hs @@ -14,7 +14,7 @@ module Hadrian.Builder ( Builder (..), BuildInfo (..), runBuilder, runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions, getBuilderPath, - builderEnvironment, askWithResources + builderEnvironment, ask, askWithResources ) where import Data.List @@ -43,7 +43,7 @@ class ShakeValue b => Builder b where builderPath :: b -> Action FilePath -- | Ask the builder for something - askBuilderWith :: b -> BuildInfo -> Action [String] -- TODO: this better be `a`, and the builder decides? + askBuilderWith :: b -> BuildInfo -> Action String -- | Make sure a builder exists and rebuild it if out of date. needBuilder :: b -> Action () @@ -82,11 +82,14 @@ runBuilderWithCmdOptions opts builder args inputs outputs = build :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action () build = buildWith [] [] +ask :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action String +ask = askWith [] [] + -- | Like 'build' but acquires necessary resources. 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 :: (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'. @@ -115,7 +118,7 @@ doWith f info rs opts target args = do 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 :: (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. diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 1e3e5ac772..c7e0afbc91 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -75,12 +75,16 @@ copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action () copyConf rs context@Context {..} conf = do let Just pkgName | takeBaseName conf == "rts" = Just "rts" | otherwise = fst <$> parseCabalName (takeBaseName conf) - depPkgIds <- askWithResources rs $ + depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $ target context (GhcPkg Dependencies stage) [pkgName] [] need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds buildWithResources rs $ do target context (GhcPkg Clone stage) [pkgName] [conf] + where + stdOutToPkgIds :: String -> [String] + stdOutToPkgIds = drop 1 . concatMap words . lines + archive :: Way -> String -> String archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index cf0047f971..79806e2417 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -56,7 +56,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault - , getPkgDataList HsArgs + , (not <$> builder (Ghc Settings)) ? getPkgDataList HsArgs , libraryPackage ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] diff --git a/src/Utilities.hs b/src/Utilities.hs index 9385810d5d..93695dca47 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -1,7 +1,7 @@ module Utilities ( build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith, needLibrary, contextDependencies, stage1Dependencies, libraryTargets, - topsortPackages, askWithResources, cabalDependencies + topsortPackages, ask, askWithResources, cabalDependencies ) where import qualified Hadrian.Builder as H @@ -24,9 +24,12 @@ 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 :: [(Resource, Int)] -> Target -> Action String askWithResources rs target = H.askWithResources rs target getArgs +ask :: Target -> Action String +ask target = H.ask target getArgs + -- | Given a 'Context' this 'Action' look up the package dependencies and wrap -- the results in appropriate contexts. The only subtlety here is that we never -- depend on packages built in 'Stage2' or later, therefore the stage of the From 73c9b775cceefdf48c574a1144e95ad411e2ffc4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 15:43:06 +0800 Subject: [PATCH 052/210] [package conf] depend on setings and platformConstants Otherwise the ghc that's pointed to the pacakge.conf won't know how to register packages. --- src/Rules/Register.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index c7e0afbc91..32ef34bcdf 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -22,7 +22,11 @@ parseCabalName = readPToMaybe parse -- boot packages db from the installed compiler. copyBootPackages :: [(Resource, Int)] -> Context -> Rules () copyBootPackages rs context@Context {..} = do - "//" ++ stage0PackageDbDir -/- "*.conf" %> copyConf rs context + "//" ++ stage0PackageDbDir -/- "*.conf" %> \conf -> do + settings <- libPath context <&> (-/- "settings") + platformConstants <- libPath context <&> (-/- "platformConstants") + need [settings, platformConstants] + copyConf rs context conf -- TODO: Simplify. -- | Build rules for registering packages and initialising package databases From 0dcb5dc9367a7983d8aa371b11ca081709a443ed Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 15:43:34 +0800 Subject: [PATCH 053/210] [stage0 ghc] Copy settings and platformConstants from the bootstrap compiler. --- src/Rules/Generate.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index b285720e97..8b3acc7358 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -172,8 +172,12 @@ copyRules = do (prefix -/- "ghc-usage.txt") <~ return "driver" (prefix -/- "ghci-usage.txt" ) <~ return "driver" (prefix -/- "llvm-targets") <~ return "." - (prefix -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir)) - (prefix -/- "settings") <~ return "." + if stage == Stage0 + then (prefix -/- "platformConstants") <~ askLibDir stage + else (prefix -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir)) + if stage == Stage0 + then (prefix -/- "settings") <~ askLibDir stage + else (prefix -/- "settings") <~ return "." (prefix -/- "template-hsc.h") <~ return (pkgPath hsc2hs) "//c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c") "//c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c") @@ -181,6 +185,12 @@ copyRules = do pattern <~ mdir = pattern %> \file -> do dir <- mdir copyFile (dir -/- takeFileName file) file + askLibDir :: Stage -> Action FilePath + askLibDir stage = do + info <- read <$> ask (target (vanillaContext stage ghc) (Ghc Settings stage) [] []) + case lookup "LibDir" info of + Just libdir -> return libdir + Nothing -> error $ "unable to get libdir from ghc" generateRules :: Rules () generateRules = do From 9aa2ace06537d408ad015a058b51f39fc6e6cc45 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 16:34:39 +0800 Subject: [PATCH 054/210] [ghc-cabal] pass -ghc-version if needed. --- src/Settings/Builders/GhcCabal.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index f8db52ea98..c3700abd89 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -96,7 +96,8 @@ 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=-ghc-version=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] bootPackageConstraints :: Args bootPackageConstraints = stage0 ? do From 66c776dc49717775d9b383103234ff1d47f37352 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 16:34:56 +0800 Subject: [PATCH 055/210] [register] need setup-config Still ugly. --- src/Rules/Register.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 32ef34bcdf..9b4c76d4b5 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -107,7 +107,11 @@ buildConf rs context@Context {..} conf = do depPkgIds <- cabalDependencies context confIn <- pkgInplaceConfig context - need [confIn] + -- setup-config, triggers `ghc-cabal configure` + -- everything of a package should depend on that + -- in the first place. + setupConfig <- (contextPath context) <&> (-/- "setup-config") + need [confIn, setupConfig] need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds From daec6c9e9e8a32d0556a7e4b409526d5cd50e2d2 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 18:01:49 +0800 Subject: [PATCH 056/210] fix pkgFile path --- src/Context.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index d04e80cd3f..64df040142 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -116,9 +116,9 @@ libPath context = buildRoot <&> (-/- libDir context) pkgFile :: Context -> String -> String -> Action FilePath pkgFile context@Context {..} prefix suffix = do - path <- libPath context + path <- buildPath context pid <- pkgId package - return $ path -/- pid -/- prefix ++ pid ++ suffix + return $ path -/- prefix ++ pid ++ suffix -- | Path to inplace package configuration file of a given 'Context'. pkgInplaceConfig :: Context -> Action FilePath From 191430b4b960e6ebdaf4c808ad27bf6eff991363 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 18:03:12 +0800 Subject: [PATCH 057/210] config file is not a library target. --- src/Utilities.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Utilities.hs b/src/Utilities.hs index 93695dca47..e37d6c8255 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -58,7 +58,6 @@ 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 @@ -66,12 +65,13 @@ libraryTargets includeGhciLib context = do 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 ] + let ghci = ghciFlag == "YES" + liftIO $ putStrLn $ "GHCI: " ++ show ghciFlag + return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ] -- | Coarse-grain 'need': make sure all given libraries are fully built. needLibrary :: [Context] -> Action () -needLibrary cs = need =<< concatMapM (libraryTargets True) cs +needLibrary cs = need =<< mapM pkgConfFile cs -- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344. -- | Topological sort of packages according to their dependencies. From 19347880c86790ae67b2772fcce0b48b1051c5d7 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 30 Oct 2017 19:20:04 +0800 Subject: [PATCH 058/210] [rts] it's a cabal package! --- src/GHC.hs | 5 ++++- src/Rules/Register.hs | 10 +++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index a2a23829f6..0f6b582ae0 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -245,7 +245,10 @@ programPath context@Context {..} = do -- 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 + , unlit + ]) || package == ghcCabal && stage == Stage0 -- | Some program packages should not be linked with Haskell main function. diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 9b4c76d4b5..47c1fb0248 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -7,6 +7,8 @@ import GHC import Target import Utilities import Oracles.Setting +import Hadrian.Expression +import Settings import Distribution.ParseUtils import qualified Distribution.Compat.ReadP as Parse @@ -117,10 +119,12 @@ buildConf rs context@Context {..} conf = do -- ghc-cabal copy libraries/terminfo $PWD/_build/stage0/libraries/terminfo : $PWD/_build/stage1 "" "lib" "share" "v" -- ghc-cabal register libraries/terminfo $PWD/_build/stage0/libraries/terminfo ghc ghc-pkg $PWD/_build/stage1/lib $PWD/_build_stage1 "" "lib" "share" YES - _a <- buildPath context <&> (-/- archive way pkgId) - _o <- buildPath context <&> (-/- pkgObject way pkgId) - need [_a, _o] + ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) + + liftIO . putStrLn . show =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] + + need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] -- might need some package-db resource to limit read/write, -- see packageRules From 37b6b91afdf53be2876c4f22b195b9cd3902597f Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 31 Oct 2017 10:45:36 +0800 Subject: [PATCH 059/210] [Evac_thr] drop custom logic. Not present in make system anymore. --- src/Rules/Compile.hs | 4 +++- src/Rules/Generate.hs | 7 +------ src/Rules/PackageData.hs | 3 +-- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs index 91529b715e..22fe19ae33 100644 --- a/src/Rules/Compile.hs +++ b/src/Rules/Compile.hs @@ -14,11 +14,13 @@ compilePackage rs context@Context {..} = do let dir = "//" ++ buildDir context nonHs extension = dir -/- extension "*" <.> osuf way compile compiler obj2src obj = do + -- need =<< interpretInContext context generatedDependencies src <- obj2src context obj need [src] needDependencies context src $ obj <.> "d" buildWithResources rs $ target context (compiler stage) [src] [obj] compileHs = \[obj, _hi] -> do + -- need =<< interpretInContext context generatedDependencies path <- contextPath context (src, deps) <- lookupDependencies (path -/- ".dependencies") obj need $ src : deps @@ -26,7 +28,7 @@ compilePackage rs context@Context {..} = do buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj] priority 2.0 $ do - nonHs "c" %> compile (Ghc CompileCWithGhc) (obj2src "c" isGeneratedCFile ) + nonHs "c" %> compile (Ghc CompileCWithGhc) (obj2src "c" $ const False ) nonHs "cmm" %> compile (Ghc CompileHs) (obj2src "cmm" isGeneratedCmmFile) nonHs "s" %> compile (Ghc CompileHs) (obj2src "S" $ const False ) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 8b3acc7358..0d55996daf 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -1,5 +1,5 @@ module Rules.Generate ( - isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules, + isGeneratedCmmFile, generatePackageCode, generateRules, copyRules, includesDependencies, generatedDependencies ) where @@ -49,9 +49,6 @@ primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" platformH :: Stage -> FilePath platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" -isGeneratedCFile :: FilePath -> Bool -isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"] - isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -179,8 +176,6 @@ copyRules = do then (prefix -/- "settings") <~ askLibDir stage else (prefix -/- "settings") <~ return "." (prefix -/- "template-hsc.h") <~ return (pkgPath hsc2hs) - "//c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c") - "//c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c") where pattern <~ mdir = pattern %> \file -> do dir <- mdir diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index c706ef75fb..8a454c8c51 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -76,8 +76,7 @@ packageCSources pkg sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) . map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++ [ if windows then "win32" else "posix" ] - return $ sources ++ [ rtsPath -/- "c/sm/Evac_thr.c" ] - ++ [ rtsPath -/- "c/sm/Scav_thr.c" ] + return sources packageAsmSources :: Package -> Action [FilePath] packageAsmSources pkg From 7d95f466a31d5cd4601baffe0d5dd62213e64e46 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 31 Oct 2017 10:51:00 +0800 Subject: [PATCH 060/210] Inject .cmm and .s sources as needed. Until this is fixed in cabal, there is no other way. --- src/Rules/PackageData.hs | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 8a454c8c51..4fcd179c20 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -80,21 +80,23 @@ packageCSources pkg packageAsmSources :: Package -> Action [FilePath] packageAsmSources pkg - | pkg /= rts = return [] - | otherwise = do + | pkg == rts = do buildAdjustor <- anyTargetArch ["i386", "powerpc", "powerpc64"] buildStgCRunAsm <- anyTargetArch ["powerpc64le"] return $ [ "AdjustorAsm.S" | buildAdjustor ] ++ [ "StgCRunAsm.S" | buildStgCRunAsm ] + | otherwise = return [] packageCmmSources :: Package -> Action [FilePath] packageCmmSources pkg - | pkg /= rts = return [] - | otherwise = do + | pkg == rts = do rtsPath <- rtsBuildPath sources <- getDirectoryFiles (pkgPath pkg) ["*.cmm"] return $ sources ++ [ rtsPath -/- "cmm/AutoApply.cmm" ] - + | pkg == base = do + sources <- getDirectoryFiles (pkgPath pkg) ["cbits/*.cmm"] + return sources + | otherwise = return [] -- 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 ...@ @@ -104,12 +106,17 @@ packageCmmSources pkg -- 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 +-- +-- Note: we also inject the cmm and asm sources here, as there is no way to +-- specify them with cabal yet. postProcessPackageData :: Context -> FilePath -> Action () postProcessPackageData context@Context {..} file = do top <- topDirectory - cmmSrcs <- getDirectoryFiles (pkgPath package) ["cbits/*.cmm"] + cmmSrcs <- packageCmmSources package + asmSrcs <- packageAsmSources package path <- contextPath context let len = length (pkgPath package) + length (top -/- path) + 2 fixFile file $ unlines - . (++ ["CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) ]) + . (++ [ "CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) + , "S_SRCS = " ++ unwords (map unifyPath asmSrcs) ]) . map (drop len) . filter ('$' `notElem`) . lines From 944c894b4f414fc363d6b2695177aa5f545af1ae Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 31 Oct 2017 11:10:18 +0800 Subject: [PATCH 061/210] [Evac_thr] drop PARALLEL_GC. This is now included in the Evac_thr file, and doesn't need to be handled special anymore. --- src/Settings/Packages/Rts.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index 7282a0eec6..a8ce4e1979 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -170,9 +170,6 @@ rtsPackageArgs = package rts ? do , (not <$> flag GccIsClang) ? inputs ["//Compact.c"] ? arg "-finline-limit=2500" - , inputs ["//Evac_thr.c", "//Scav_thr.c"] ? - pure ["-DPARALLEL_GC", "-Irts/sm"] - , input "//StgCRun.c" ? windowsHost ? arg "-Wno-return-local-addr" , input "//RetainerProfile.c" ? flag GccIsClang ? arg "-Wno-incompatible-pointer-types" From 90dd2fb857cd23bc19db2614844bbe2f748b80d7 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 31 Oct 2017 11:11:21 +0800 Subject: [PATCH 062/210] Drop debug. --- src/Rules/Register.hs | 3 --- src/Utilities.hs | 1 - 2 files changed, 4 deletions(-) diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 47c1fb0248..5cf15ac05c 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -121,9 +121,6 @@ buildConf rs context@Context {..} conf = do -- ghc-cabal register libraries/terminfo $PWD/_build/stage0/libraries/terminfo ghc ghc-pkg $PWD/_build/stage1/lib $PWD/_build_stage1 "" "lib" "share" YES ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) - - liftIO . putStrLn . show =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] - need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] -- might need some package-db resource to limit read/write, diff --git a/src/Utilities.hs b/src/Utilities.hs index e37d6c8255..2a05694641 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -66,7 +66,6 @@ libraryTargets includeGhciLib context = do then interpretInContext context $ getPkgData BuildGhciLib else return "NO" let ghci = ghciFlag == "YES" - liftIO $ putStrLn $ "GHCI: " ++ show ghciFlag return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ] -- | Coarse-grain 'need': make sure all given libraries are fully built. From a02a9ffaf4d518df3ed645c474744a85ed732e39 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 31 Oct 2017 17:53:45 +0800 Subject: [PATCH 063/210] Adds Builder boot file To solve mutual recursion issues. --- src/Builder.hs-boot | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 src/Builder.hs-boot diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot new file mode 100644 index 0000000000..562287ce62 --- /dev/null +++ b/src/Builder.hs-boot @@ -0,0 +1,38 @@ +module Builder where + +import Stage +import Hadrian.Builder.Ar + +data CcMode = CompileC | FindCDependencies +data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs +data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist +data GhcPkgMode = Init | Update | Clone | Dependencies +data HaddockMode = BuildPackage | BuildIndex +data SphinxMode = Html | Latex | Man +data TarMode = Create | Extract +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 + | HsCpp + | Hsc2Hs Stage + | Ld + | Make FilePath + | Nm + | Objdump + | Patch + | Perl + | Ranlib + | Sphinx SphinxMode + | Tar TarMode + | Unlit + | Xelatex From 25fedd8f2b2143ff21d9f6ed4c61e0115bf0710d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 09:50:33 +0800 Subject: [PATCH 064/210] Builder with boot! --- src/Builder.hs | 5 +++++ src/Builder.hs-boot | 3 +++ 2 files changed, 8 insertions(+) diff --git a/src/Builder.hs b/src/Builder.hs index c3d093a063..bd23bfbb0d 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -4,6 +4,8 @@ module Builder ( ArMode (..), CcMode (..), GhcCabalMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..), SphinxMode (..), TarMode (..), Builder (..), + builderPath', + -- * Builder properties builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, @@ -150,6 +152,9 @@ 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 diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index 562287ce62..4832481ae0 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -2,6 +2,7 @@ module Builder where import Stage import Hadrian.Builder.Ar +import Development.Shake data CcMode = CompileC | FindCDependencies data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs @@ -36,3 +37,5 @@ data Builder = Alex | Tar TarMode | Unlit | Xelatex + +builderPath' :: Builder -> Action FilePath \ No newline at end of file From 02df95c2dad50b3ef8a935785cec3a31bfc0d483 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 09:51:19 +0800 Subject: [PATCH 065/210] Staged cabal logic. --- src/Expression.hs | 11 +++++++- src/Hadrian/Haskell/Cabal.hs | 11 ++++---- src/Hadrian/Haskell/Cabal/Parse.hs | 45 ++++++++++++++++++++++-------- src/Hadrian/Oracles/TextFile.hs | 29 ++++++++++++------- 4 files changed, 69 insertions(+), 27 deletions(-) diff --git a/src/Expression.hs b/src/Expression.hs index b7e1838e08..115a353333 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -14,7 +14,7 @@ module Expression ( -- * Convenient accessors getBuildRoot, getContext, getPkgData, getPkgDataList, getOutputs, getInputs, - getInput, getOutput, + getInput, getOutput, getCabalData, -- * Re-exports module Base, @@ -25,6 +25,8 @@ module Expression ( import qualified Hadrian.Expression as H import Hadrian.Expression hiding (Expr, Predicate, Args) +import Hadrian.Haskell.Cabal.Parse (Cabal) +import Hadrian.Oracles.TextFile (readCabalFile') import Base import Builder @@ -51,6 +53,13 @@ getPkgData key = expr . pkgData . key =<< getContextPath getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String] getPkgDataList key = expr . pkgDataList . key =<< getContextPath +getCabalData :: (Cabal -> a) -> Expr a +getCabalData key = do + stage <- getStage + path <- unsafePkgCabalFile <$> getPackage + cabal <- expr (readCabalFile' stage path) + return $ key cabal + -- | Is the build currently in the provided stage? stage :: Stage -> Predicate stage s = (s ==) <$> getStage diff --git a/src/Hadrian/Haskell/Cabal.hs b/src/Hadrian/Haskell/Cabal.hs index bc70efb687..5b50bc99c6 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -13,6 +13,7 @@ module Hadrian.Haskell.Cabal ( pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis ) where +import Stage import Development.Shake import Hadrian.Haskell.Cabal.Parse @@ -21,13 +22,13 @@ 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 cabalFile = version <$> readCabalFile' Stage0 cabalFile -- | 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 + cabal <- readCabalFile' Stage0 cabalFile return $ if (null $ version cabal) then name cabal else name cabal ++ "-" ++ version cabal @@ -36,9 +37,9 @@ pkgIdentifier cabalFile = do -- 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 :: Stage -> FilePath -> Action [PackageName] +pkgDependencies stage cabalFile = dependencies <$> readCabalFile' stage cabalFile -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: FilePath -> Action String -pkgSynopsis cabalFile = synopsis <$> readCabalFile cabalFile +pkgSynopsis cabalFile = synopsis <$> readCabalFile' Stage0 cabalFile diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 578eeacc52..1adc725bff 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -8,19 +8,26 @@ -- -- Extracting Haskell package metadata stored in Cabal files. ----------------------------------------------------------------------------- -module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal) where +module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal, parseCabalPkgId, cabalCcArgs, cabalIncludeDirs) where +import Stage +import {-# SOURCE #-} Builder hiding (Builder) +-- import Hadrian.Builder as H import Data.List.Extra import Development.Shake import Development.Shake.Classes import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C import qualified Distribution.PackageDescription.Parse as C +import qualified Distribution.PackageDescription.Configuration as C import qualified Distribution.Text as C import qualified Distribution.Types.CondTree as C import qualified Distribution.Verbosity as C - +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.Program.Db as Db +import Distribution.Simple.Compiler (compilerInfo) import Hadrian.Package +import GHC.Generics -- TODO: Use fine-grain tracking instead of tracking the whole Cabal file. -- | Haskell package metadata extracted from a Cabal file. @@ -29,23 +36,39 @@ data Cabal = Cabal , name :: PackageName , synopsis :: String , version :: String - } deriving (Eq, Read, Show, Typeable) + , packageDesc :: C.PackageDescription + } deriving (Eq, Read, 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) = a `seq` b `seq` c `seq` d `seq` e `seq` () + +parseCabalPkgId :: FilePath -> IO String +parseCabalPkgId file = show . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file + +cabalCcArgs :: Cabal -> [String] +cabalCcArgs c = concatMap C.ccOptions [ C.libBuildInfo lib | (Just lib) <- [C.library (packageDesc c)] + , C.buildable . C.libBuildInfo $ lib ] + + +cabalIncludeDirs :: Cabal -> [String] +cabalIncludeDirs c = concatMap C.includeDirs [ C.libBuildInfo lib | (Just lib) <- [C.library (packageDesc c)] + , C.buildable . C.libBuildInfo $ lib ] + +--cabalDepIncludeDirs -- | Parse a Cabal file. -parseCabal :: FilePath -> IO Cabal -parseCabal file = do +parseCabal :: Stage -> FilePath -> Action Cabal +parseCabal stage file = do + hcPath <- builderPath' (Ghc CompileHs stage) + (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb gpd <- liftIO $ C.readGenericPackageDescription C.silent file - let pd = C.packageDescription gpd + let (Right (pd,_)) = C.finalizePackageDescription [] (const True) platform (compilerInfo compiler) [] gpd + let -- pd = C.packageDescription gpd pkgId = C.package pd name = C.unPackageName (C.pkgName pkgId) version = C.display (C.pkgVersion pkgId) @@ -54,7 +77,7 @@ parseCabal file = do 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 + return $ Cabal deps name (C.synopsis pd) version pd collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency] collectDeps Nothing = [] diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index c2ecb4c18b..0502ff11d7 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -13,9 +13,11 @@ module Hadrian.Oracles.TextFile ( readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, - readCabalFile, textFileOracle + readCabalFile, readCabalFile', textFileOracle ) where +import Stage + import Control.Monad import qualified Data.HashMap.Strict as Map import Data.Maybe @@ -30,9 +32,9 @@ newtype TextFile = TextFile FilePath deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult TextFile = String -newtype CabalFile = CabalFile FilePath +newtype CabalFile = CabalFile (Stage, FilePath) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) -type instance RuleResult CabalFile = Cabal +type instance RuleResult CabalFile = Maybe Cabal newtype KeyValue = KeyValue (FilePath, String) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -90,8 +92,11 @@ 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 = askOracle . CabalFile +readCabalFile :: Stage -> FilePath -> Action (Maybe Cabal) +readCabalFile stage file = askOracle $ CabalFile (stage, file) + +readCabalFile' :: Stage -> FilePath -> Action Cabal +readCabalFile' stage file = fromJust <$> readCabalFile stage file -- | This oracle reads and parses text files to answer 'readTextFile' and -- 'lookupValue' queries, as well as their derivatives, tracking the results. @@ -116,8 +121,12 @@ 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 + cabalMap <- fmap Map.fromList . forM [Stage0 ..] $ \stage -> do + cabal <- newCache $ \file -> do + need [file] + putLoud $ "| CabalFile oracle: reading " ++ quote file ++ "..." + parseCabal stage file + return (stage, cabal) + void $ addOracle $ \(CabalFile (stage, file)) -> case Map.lookup stage cabalMap of + Just cabal -> Just <$> cabal file + Nothing -> return $ Nothing From 3765f808feeec36dfbd0f4199b52a5a6cb329a4d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 09:51:32 +0800 Subject: [PATCH 066/210] simplify pkgId lookup --- src/Rules/Library.hs | 24 ++++-------------------- src/Rules/Register.hs | 12 ++---------- 2 files changed, 6 insertions(+), 30 deletions(-) diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 3528dba006..a313393846 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -36,11 +36,7 @@ pkgObject way pkgId = "HS" ++ pkgId ++ (waySuffix way <.> "o") library :: Context -> Rules () library context@Context{..} = do pkgId <- case pkgCabalFile package of - Just file -> do - cabal <- liftIO $ parseCabal file - return $ if (null $ version cabal) - then Cabal.name cabal - else Cabal.name cabal ++ "-" ++ version cabal + Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) "//" ++ libDir context -/- pkgId -/- archive way pkgId %> \a -> do @@ -67,11 +63,7 @@ libraryObjects context@Context{..} = do buildDynamicLib :: Context -> Rules () buildDynamicLib context@Context{..} = do pkgId <- case pkgCabalFile package of - Just file -> do - cabal <- liftIO $ parseCabal file - return $ if (null $ version cabal) - then Cabal.name cabal - else Cabal.name cabal ++ "-" ++ version cabal + Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgId @@ -90,11 +82,7 @@ buildDynamicLib context@Context{..} = do buildPackageLibrary :: Context -> Rules () buildPackageLibrary context@Context {..} = do pkgId <- case pkgCabalFile package of - Just file -> do - cabal <- liftIO $ parseCabal file - return $ if (null $ version cabal) - then Cabal.name cabal - else Cabal.name cabal ++ "-" ++ version cabal + Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgId @@ -117,11 +105,7 @@ buildPackageLibrary context@Context {..} = do buildPackageGhciLibrary :: Context -> Rules () buildPackageGhciLibrary context@Context {..} = priority 2 $ do pkgId <- case pkgCabalFile package of - Just file -> do - cabal <- liftIO $ parseCabal file - return $ if (null $ version cabal) - then Cabal.name cabal - else Cabal.name cabal ++ "-" ++ version cabal + Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) let libPrefix = "//" ++ buildDir context -/- "HS" ++ pkgId diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 5cf15ac05c..a8408263ed 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -36,11 +36,7 @@ copyBootPackages rs context@Context {..} = do registerPackage :: [(Resource, Int)] -> Context -> Rules () registerPackage rs context@Context {..} = do pkgId <- case pkgCabalFile package of - Just file -> do - cabal <- liftIO $ parseCabal file - return $ if (null $ version cabal) - then Cabal.name cabal - else Cabal.name cabal ++ "-" ++ version cabal + Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) -- 'rts' has no version. As such we should never generate a rule for the @@ -100,11 +96,7 @@ pkgObject way pkgId = "HS" ++ pkgId ++ (waySuffix way <.> "o") buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () buildConf rs context@Context {..} conf = do pkgId <- case pkgCabalFile package of - Just file -> do - cabal <- liftIO $ parseCabal file - return $ if (null $ version cabal) - then Cabal.name cabal - else Cabal.name cabal ++ "-" ++ version cabal + Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) depPkgIds <- cabalDependencies context From 311b9a6cb1363d56e4676869d3979cb61c061252 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 10:16:54 +0800 Subject: [PATCH 067/210] staged deps --- src/Utilities.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Utilities.hs b/src/Utilities.hs index 2a05694641..7a98e7320c 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -42,7 +42,7 @@ contextDependencies Context {..} = case pkgCabalFile package of Just cabalFile -> do let depStage = min stage Stage1 depContext = \pkg -> Context depStage pkg way - deps <- pkgDependencies cabalFile + deps <- pkgDependencies stage cabalFile pkgs <- sort <$> stagePackages depStage return . map depContext $ intersectOrd (compare . pkgName) pkgs deps From 0b3d01a8821646ab12b566c186faa31f5e8f0f2e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 10:18:12 +0800 Subject: [PATCH 068/210] Use cabalData --- src/Settings/Builders/Cc.hs | 3 ++- src/Settings/Builders/Common.hs | 4 +++- src/Settings/Builders/Ghc.hs | 3 ++- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index 7dc4423a2b..e54372ebce 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -1,12 +1,13 @@ module Settings.Builders.Cc (ccBuilderArgs) where import Settings.Builders.Common +import Hadrian.Haskell.Cabal.Parse (cabalCcArgs) ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay builder Cc ? mconcat - [ getPkgDataList CcArgs + [ getCabalData cabalCcArgs , getStagedSettingList ConfCcArgs , cIncludeArgs diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index e7af38bc4d..871bf7c10e 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -17,12 +17,14 @@ import Oracles.Setting import Settings import UserSettings +import Hadrian.Haskell.Cabal.Parse (cabalIncludeDirs) + cIncludeArgs :: Args cIncludeArgs = do pkg <- getPackage root <- getBuildRoot path <- getBuildPath - incDirs <- getPkgDataList IncludeDirs + incDirs <- getCabalData cabalIncludeDirs depDirs <- getPkgDataList DepIncludeDirs cross <- expr crossCompiling compilerOrGhc <- package compiler ||^ package ghc diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 95ea793249..a9e9d9da07 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -7,6 +7,7 @@ import Hadrian.Haskell.Cabal import Flavour import Rules.Gmp import Settings.Builders.Common +import Hadrian.Haskell.Cabal.Parse (cabalCcArgs) ghcBuilderArgs :: Args ghcBuilderArgs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do @@ -27,7 +28,7 @@ needTouchy = notStage0 ? windowsHost ? do ghcCBuilderArgs :: Args ghcCBuilderArgs = builder (Ghc CompileCWithGhc) ? do way <- getWay - let ccArgs = [ getPkgDataList CcArgs + let ccArgs = [ getCabalData cabalCcArgs , getStagedSettingList ConfCcArgs , cIncludeArgs , arg "-Werror" From 32c44893e21422b09b7fdc89215c53bf0d022681 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 10:20:10 +0800 Subject: [PATCH 069/210] [WIP] Did not manage to get the -DPARSEC cabal to build with ghc-cabal --- src/Rules/Program.hs | 21 +++++++++++++++++++++ src/Settings/Packages/GhcCabal.hs | 9 ++++++++- 2 files changed, 29 insertions(+), 1 deletion(-) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 5d26446639..97c060311c 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -98,6 +98,27 @@ buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () buildBinary rs bin context@Context {..} = do binDeps <- if stage == Stage0 && package == ghcCabal then hsSources context + -- then do -- this is a hack, but he ghc-cabal packge only list's it's Main + -- -- it does however depend on the Lexer in lib:Cabal, and the + -- -- cbits file in libraries/text. + + -- -- it also depends on essnetially the content of all the following + -- -- libraries: Cabal/Cabal, binary, filepath, hpc, mtl, text, parsec + -- -- + -- -- We can not use the hsSource or other queries on those pacakges as + -- -- they require the package-data.mk, which in turn requires ghc-cabal. + -- -- + -- -- As such, we will ignore this for now, even though it will mean + -- -- that hadrian will not properly track the dependencies of + -- -- ghc-cabal properly. + + -- ghcCabalPath <- contextPath (context { Context.package = ghcCabal }) + -- cabalPath <- contextPath (context { Context.package = cabal }) + -- textPath <- contextPath (context { Context.package = text }) + -- return $ [ ghcCabalPath -/- "build" -/- "Main.o" + -- , cabalPath -/- "build" -/- "Cabal/Distribution/Parsec/Lexer.o" + -- , textPath -/- "build" -/- "c/cbits/cbits.o" + -- ] else do needLibrary =<< contextDependencies context when (stage > Stage0) $ do diff --git a/src/Settings/Packages/GhcCabal.hs b/src/Settings/Packages/GhcCabal.hs index b525c31dff..d0c30cd0fc 100644 --- a/src/Settings/Packages/GhcCabal.hs +++ b/src/Settings/Packages/GhcCabal.hs @@ -15,9 +15,16 @@ ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do , arg "--make" , arg "-j" , arg ("-DCABAL_VERSION=" ++ replace "." "," cabalVersion) + -- , arg "-DCABAL_PARSEC" , arg "-DBOOTSTRAPPING" , arg "-DMIN_VERSION_binary_0_8_0" , arg "-ilibraries/Cabal/Cabal" , arg "-ilibraries/binary/src" , arg "-ilibraries/filepath" - , arg "-ilibraries/hpc" ] + , arg "-ilibraries/hpc" + ] + -- , arg "-ilibraries/mtl" + -- , arg "-ilibraries/text" + -- , arg "-Ilibraries/text/include" + -- , arg "-ilibraries/parsec" + -- ] From e87768a8280b570e03f32387b580a5d40444e5f8 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 10:35:03 +0800 Subject: [PATCH 070/210] fix boot file --- src/Builder.hs-boot | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index 4832481ae0..ce271056e6 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -2,6 +2,8 @@ module Builder where import Stage import Hadrian.Builder.Ar +import Hadrian.Builder.Sphinx +import Hadrian.Builder.Tar import Development.Shake data CcMode = CompileC | FindCDependencies @@ -9,8 +11,6 @@ data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | Lin data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist data GhcPkgMode = Init | Update | Clone | Dependencies data HaddockMode = BuildPackage | BuildIndex -data SphinxMode = Html | Latex | Man -data TarMode = Create | Extract data Builder = Alex | Ar ArMode Stage | DeriveConstants From e26455548600b79e2e3c5a734c8a58b9c1cabd45 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 19:40:09 +0800 Subject: [PATCH 071/210] Cleanup Registration Rules --- src/Rules.hs | 7 ++-- src/Rules/Register.hs | 79 +++++++++++++------------------------------ 2 files changed, 26 insertions(+), 60 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index e3c812f92c..5d18ddf67a 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -98,16 +98,15 @@ packageRules = do forM_ (filter isProgram knownPackages) $ Rules.Program.buildProgram readPackageDb - - Rules.Register.copyBootPackages writePackageDb (Context Stage0 base vanilla) -- base is only a dummy here. + forM_ [Stage0 .. ] $ \stage -> do + Rules.Register.registerPackages writePackageDb (Context stage base vanilla) -- base is only a dummy here. 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 diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index a8408263ed..9ad9469a5a 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TupleSections #-} -module Rules.Register (copyBootPackages, registerPackage) where +module Rules.Register (registerPackages) where import Base import Context @@ -22,66 +22,36 @@ parseCabalName = readPToMaybe parse -- | This rule provides rules for copying packges into the -- boot packages db from the installed compiler. -copyBootPackages :: [(Resource, Int)] -> Context -> Rules () -copyBootPackages rs context@Context {..} = do - "//" ++ stage0PackageDbDir -/- "*.conf" %> \conf -> do +-- | Build rules for registering packages and initialising package databases +-- by running the @ghc-pkg@ utility. +registerPackages :: [(Resource, Int)] -> Context -> Rules () +registerPackages rs context@Context {..} = do + "//" ++ inplacePackageDbPath stage %> + buildStamp rs context + + "//" ++ inplacePackageDbPath stage -/- packageDbStamp %> \stamp -> do + writeFileLines stamp [] + + "//" ++ inplacePackageDbPath stage -/- "*.conf" %> \conf -> do settings <- libPath context <&> (-/- "settings") platformConstants <- libPath context <&> (-/- "platformConstants") - need [settings, platformConstants] - copyConf rs context conf --- TODO: Simplify. --- | 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 - pkgId <- case pkgCabalFile package of - Just file -> liftIO $ parseCabalPkgId file - Nothing -> return (pkgName package) - - -- 'rts' has no version. As such we should never generate a rule for the - -- rts in stage0. The rts is also not expected to be built for stage0. - -- We intend to copy over the pkg from the bootstrap compiler. - -- - -- This usually works if packges have - identifier. As - -- dependencies will pick from the bootstrap compiler as needed. For - -- packages without version though, this results duplicated rules for - -- the copyBootPackage and the packge. - -- - -- TODO: HACK - -- This should really come from the flavour's packages. But those are - -- currently not available at rule time... - let bootpackages = [ binary, text, transformers, mtl, parsec, cabal, hpc - , ghcBootTh, ghcBoot, templateHaskell, compiler, ghci - , terminfo -- TODO: only if Windows_HOST == NO - ] - when (stage == Stage0 && package `elem` bootpackages) $ 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 -/- pkgId ++ ".conf" %%> - buildConf rs context - - -- This is hack. This check is only here so we build it at most once. - when (package == binary) $ "//" ++ stage0PackageDbDir -/- packageDbStamp %> - buildStamp rs context - - when (stage == Stage1) $ do - "//" ++ inplacePackageDbPath stage -/- pkgId ++ ".conf" %%> - buildConf rs context - - when (package == ghc) $ "//" ++ inplacePackageDbPath stage -/- packageDbStamp %> - buildStamp rs context + need [settings, platformConstants] + let Just pkgName | takeBaseName conf == "rts" = Just "rts" + | otherwise = fst <$> parseCabalName (takeBaseName conf) + let Just pkg = findPackageByName pkgName + bootLibs <- filter isLibrary <$> (defaultPackages Stage0) + case stage of + Stage0 | not (pkg `elem` bootLibs) -> copyConf rs (context { package = pkg }) conf + _ -> buildConf rs (context { package = pkg }) conf copyConf :: [(Resource, Int)] -> Context -> FilePath -> Action () copyConf rs context@Context {..} conf = do - let Just pkgName | takeBaseName conf == "rts" = Just "rts" - | otherwise = fst <$> parseCabalName (takeBaseName conf) depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $ - target context (GhcPkg Dependencies stage) [pkgName] [] + target context (GhcPkg Dependencies stage) [pkgName package] [] need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds buildWithResources rs $ do - target context (GhcPkg Clone stage) [pkgName] [conf] + target context (GhcPkg Clone stage) [pkgName package] [conf] where stdOutToPkgIds :: String -> [String] @@ -140,10 +110,7 @@ buildConf rs context@Context {..} conf = do ] [conf] 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 From a283101dda4ec39dfa2e1112398b8ffa67f2ae70 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 1 Nov 2017 19:40:20 +0800 Subject: [PATCH 072/210] Fix package Id --- src/Hadrian/Haskell/Cabal/Parse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 1adc725bff..2da125c21f 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -48,7 +48,7 @@ instance NFData Cabal where rnf (Cabal a b c d e) = a `seq` b `seq` c `seq` d `seq` e `seq` () parseCabalPkgId :: FilePath -> IO String -parseCabalPkgId file = show . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file +parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file cabalCcArgs :: Cabal -> [String] cabalCcArgs c = concatMap C.ccOptions [ C.libBuildInfo lib | (Just lib) <- [C.library (packageDesc c)] From 4905eef7fb4afcf2a9b1bd712581be32238bb3e1 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 10:23:35 +0800 Subject: [PATCH 073/210] [dependencies] hadrian should *always* be compiled with the source-tree Cabal. As such I would argue that there should be no version bounds on the Cabal lib. --- hadrian.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hadrian.cabal b/hadrian.cabal index 7bb249efc1..bbad599c54 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -117,7 +117,7 @@ executable hadrian , TypeFamilies build-depends: base >= 4.8 && < 5 , ansi-terminal == 0.6.* - , Cabal == 2.0.0.2 + , Cabal , containers == 0.5.* , directory >= 1.2 && < 1.4 , extra >= 1.4.7 From 8c6ac16f58d36b76a871720a94ac01c6b23d732d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 12:21:29 +0800 Subject: [PATCH 074/210] [WIP] inject the hook logic from ghc-cabal --- src/Hadrian/Haskell/Cabal/Parse.hs | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 2da125c21f..72c83b4433 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -64,10 +64,34 @@ cabalIncludeDirs c = concatMap C.includeDirs [ C.libBuildInfo lib | (Just lib) < -- | Parse a Cabal file. parseCabal :: Stage -> FilePath -> Action Cabal parseCabal stage file = do + -- read the package description from the cabal file + gpd <- liftIO $ C.readGenericPackageDescription C.silent file + + -- figure out what hooks we need. + let hooks = case buildType (flattenPackageDescription gpd) of + Just Configure -> 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. + Just Custom -> + do configureExists <- doesFileExist (replaceFileName file "configure") + if configureExists + then autoconfUserHooks + else simpleUserHooks + -- not quite right, but good enough for us: + _ | (pkgName . package . packageDescription $ gpd) == mkPackageName "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. + simpleUserHooks { postConf = \_ _ _ _ -> return () } + | otherwise -> simpleUserHooks + + defaultMainWithHooksNoReadArgs hooks gpd ["configure", "--distdir", undefined, "--ipid", "$pkg-$version"] + hcPath <- builderPath' (Ghc CompileHs stage) (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb - gpd <- liftIO $ C.readGenericPackageDescription C.silent file - let (Right (pd,_)) = C.finalizePackageDescription [] (const True) platform (compilerInfo compiler) [] gpd + + let (Right (pd,_)) = C.finalizePackageDescription mempty (const True) platform (compilerInfo compiler) [] gpd let -- pd = C.packageDescription gpd pkgId = C.package pd name = C.unPackageName (C.pkgName pkgId) From 9869a6089b2876a5d91b5c0c2852ad8d829e32d8 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 15:35:32 +0800 Subject: [PATCH 075/210] [GHC] Split packages. --- src/GHC.hs | 102 +--------------------------------------- src/GHC/Packages.hs | 110 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 111 insertions(+), 101 deletions(-) create mode 100644 src/GHC/Packages.hs diff --git a/src/GHC.hs b/src/GHC.hs index 0f6b582ae0..8f47af5d1d 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -23,107 +23,7 @@ import Context import Oracles.Setting import Oracles.Flag (crossCompiling) --- | 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, 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 = hsPrg "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 = 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 GHC.Packages -- | Packages that are built by default. You can change this in "UserSettings". defaultPackages :: Stage -> Action [Package] diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs new file mode 100644 index 0000000000..7b8381632e --- /dev/null +++ b/src/GHC/Packages.hs @@ -0,0 +1,110 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +module GHC.Packages where + +import Types.Package +import Types.Stage + +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, ghcCabal, 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 ] + +-- 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 = hsPrg "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 = 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 } From 8819da94a139f8d3ff6ca9b131390686ca14181c Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 15:37:51 +0800 Subject: [PATCH 076/210] Split data types and Context.Paths --- hadrian.cabal | 6 ++++++ src/Context.hs | 49 +++--------------------------------------- src/Context/Paths.hs | 40 ++++++++++++++++++++++++++++++++++ src/Hadrian/Package.hs | 41 +---------------------------------- src/Stage.hs | 26 +--------------------- src/Types/Context.hs | 21 ++++++++++++++++++ src/Types/Package.hs | 46 +++++++++++++++++++++++++++++++++++++++ src/Types/Stage.hs | 28 ++++++++++++++++++++++++ 8 files changed, 146 insertions(+), 111 deletions(-) create mode 100644 src/Context/Paths.hs create mode 100644 src/Types/Context.hs create mode 100644 src/Types/Package.hs create mode 100644 src/Types/Stage.hs diff --git a/hadrian.cabal b/hadrian.cabal index bbad599c54..11123c392e 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -22,10 +22,12 @@ executable hadrian , Builder , CommandLine , Context + , Context.Paths , Environment , Expression , Flavour , GHC + , GHC.Package , Hadrian.Builder , Hadrian.Builder.Ar , Hadrian.Builder.Sphinx @@ -100,6 +102,9 @@ executable hadrian , Settings.Packages.Rts , Settings.Packages.RunGhc , Stage + , Types.Context + , Types.Package + , Types.Stage , Target , UserSettings , Utilities @@ -119,6 +124,7 @@ executable hadrian , ansi-terminal == 0.6.* , Cabal , containers == 0.5.* + , filepath , directory >= 1.2 && < 1.4 , extra >= 1.4.7 , mtl == 2.2.* diff --git a/src/Context.hs b/src/Context.hs index 64df040142..12a5219e82 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -17,21 +17,12 @@ import GHC.Generics import Hadrian.Expression import Hadrian.Haskell.Cabal +import Types.Context +import Context.Paths + import Base import Oracles.Setting --- | Build context for a currently built 'Target'. We generate potentially --- different build rules for each 'Context'. -data Context = Context - { stage :: Stage -- ^ Currently build Stage - , package :: Package -- ^ Currently build Package - , way :: Way -- ^ Currently build Way (usually 'vanilla') - } deriving (Eq, Generic, Show) - -instance Binary Context -instance Hashable Context -instance NFData Context - -- | Most targets are built only one way, hence the notion of 'vanillaContext'. vanillaContext :: Stage -> Package -> Context vanillaContext s p = Context s p vanilla @@ -66,40 +57,6 @@ withHsPackage expr = do Just file -> expr file Nothing -> mempty --- | 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 artefacts 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 artefacts. -buildDir :: Context -> FilePath -buildDir context = contextDir context -/- "build" - --- | Path to the directory containing build artefacts 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 - pkgId :: Package -> Action FilePath pkgId package = case pkgCabalFile package of Just file -> pkgIdentifier file diff --git a/src/Context/Paths.hs b/src/Context/Paths.hs new file mode 100644 index 0000000000..274b27be15 --- /dev/null +++ b/src/Context/Paths.hs @@ -0,0 +1,40 @@ +module Context.Paths where + +import Base + +import Hadrian.Expression +import Types.Context + +-- | 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 artefacts 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 artefacts. +buildDir :: Context -> FilePath +buildDir context = contextDir context -/- "build" + +-- | Path to the directory containing build artefacts 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/Hadrian/Package.hs b/src/Hadrian/Package.hs index 32844b80f7..064386ad06 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -30,46 +30,7 @@ import GHC.Generics import GHC.Stack import Hadrian.Utilities -data PackageLanguage = C | Haskell deriving (Generic, Show) - --- TODO: Make PackageType more precise. --- See https://github.com/snowleopard/hadrian/issues/12. -data PackageType = Library | Program deriving (Generic, Show) - -type PackageName = String - --- TODO: Consider turning Package into a GADT indexed with language and type. -data Package = Package { - -- | The package language. 'C' and 'Haskell' packages are supported. - pkgLanguage :: PackageLanguage, - -- | The package type. 'Library' and 'Program' packages are supported. - pkgType :: PackageType, - -- | The package name. We assume that all packages have different names, - -- hence two packages with the same name are considered equal. - pkgName :: PackageName, - -- | The path to the package source code relative to the root of the build - -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the - -- @Cabal@ and @ghc-bin@ packages in GHC. - pkgPath :: FilePath - } deriving (Generic, Show) - -instance Eq Package where - p == q = pkgName p == pkgName q - -instance Ord Package where - compare p q = compare (pkgName p) (pkgName q) - -instance Binary PackageLanguage -instance Hashable PackageLanguage -instance NFData PackageLanguage - -instance Binary PackageType -instance Hashable PackageType -instance NFData PackageType - -instance Binary Package -instance Hashable Package -instance NFData Package +import Types.Package -- | Construct a C library package. cLibrary :: PackageName -> FilePath -> Package diff --git a/src/Stage.hs b/src/Stage.hs index 7c9405c2b8..7cefb0c0d6 100644 --- a/src/Stage.hs +++ b/src/Stage.hs @@ -1,30 +1,6 @@ module Stage (Stage (..), stageString) where -import Development.Shake.Classes -import GHC.Generics - --- | A stage refers to a certain compiler in GHC's build process. --- --- * Stage 0 is built with the bootstrapping compiler, i.e. the one already --- installed on the user's system. The compiler that is produced during --- stage 0 is called /stage 1 compiler/. --- --- * Stage 1 is built using the stage 1 compiler and all GHC sources. The result --- is called /stage 2 compiler/ and it has all features of the new GHC. --- --- * Stage 2 is built using the stage 2 compiler. The result is a compiler --- fully "built by itself", commonly referred to as /bootstrapping/. --- --- * Stage 3 is built as a self test. The resulting compiler should have --- the same object code as the one built in stage 2, which is a good test --- for the compiler. Since it serves no other purpose than that, the stage 3 --- build is usually omitted in the build process. -data Stage = Stage0 | Stage1 | Stage2 | Stage3 - deriving (Show, Eq, Ord, Enum, Generic, Bounded) - -instance Binary Stage -instance Hashable Stage -instance NFData Stage +import Types.Stage -- | Prettyprint a 'Stage'. stageString :: Stage -> String diff --git a/src/Types/Context.hs b/src/Types/Context.hs new file mode 100644 index 0000000000..476ea6a0cd --- /dev/null +++ b/src/Types/Context.hs @@ -0,0 +1,21 @@ +module Types.Context where + +import Types.Stage +import Types.Package +import Way + +import GHC.Generics +import Development.Shake.Classes + +-- | Build context for a currently built 'Target'. We generate potentially +-- different build rules for each 'Context'. +data Context = Context + { stage :: Stage -- ^ Currently build Stage + , package :: Package -- ^ Currently build Package + , way :: Way -- ^ Currently build Way (usually 'vanilla') + } deriving (Eq, Generic, Show) + +instance Binary Context +instance Hashable Context +instance NFData Context + diff --git a/src/Types/Package.hs b/src/Types/Package.hs new file mode 100644 index 0000000000..03973cf2ba --- /dev/null +++ b/src/Types/Package.hs @@ -0,0 +1,46 @@ +module Types.Package where + +import GHC.Generics +import Development.Shake.Classes + +data PackageLanguage = C | Haskell deriving (Generic, Show) + +-- TODO: Make PackageType more precise. +-- See https://github.com/snowleopard/hadrian/issues/12. +data PackageType = Library | Program deriving (Generic, Show) + +type PackageName = String + +-- TODO: Consider turning Package into a GADT indexed with language and type. +data Package = Package { + -- | The package language. 'C' and 'Haskell' packages are supported. + pkgLanguage :: PackageLanguage, + -- | The package type. 'Library' and 'Program' packages are supported. + pkgType :: PackageType, + -- | The package name. We assume that all packages have different names, + -- hence two packages with the same name are considered equal. + pkgName :: PackageName, + -- | The path to the package source code relative to the root of the build + -- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the + -- @Cabal@ and @ghc-bin@ packages in GHC. + pkgPath :: FilePath + } deriving (Generic, Show) + +instance Eq Package where + p == q = pkgName p == pkgName q + +instance Ord Package where + compare p q = compare (pkgName p) (pkgName q) + +instance Binary PackageLanguage +instance Hashable PackageLanguage +instance NFData PackageLanguage + +instance Binary PackageType +instance Hashable PackageType +instance NFData PackageType + +instance Binary Package +instance Hashable Package +instance NFData Package + diff --git a/src/Types/Stage.hs b/src/Types/Stage.hs new file mode 100644 index 0000000000..ea651412b1 --- /dev/null +++ b/src/Types/Stage.hs @@ -0,0 +1,28 @@ +module Types.Stage where + +import Development.Shake.Classes +import GHC.Generics + +-- | A stage refers to a certain compiler in GHC's build process. +-- +-- * Stage 0 is built with the bootstrapping compiler, i.e. the one already +-- installed on the user's system. The compiler that is produced during +-- stage 0 is called /stage 1 compiler/. +-- +-- * Stage 1 is built using the stage 1 compiler and all GHC sources. The result +-- is called /stage 2 compiler/ and it has all features of the new GHC. +-- +-- * Stage 2 is built using the stage 2 compiler. The result is a compiler +-- fully "built by itself", commonly referred to as /bootstrapping/. +-- +-- * Stage 3 is built as a self test. The resulting compiler should have +-- the same object code as the one built in stage 2, which is a good test +-- for the compiler. Since it serves no other purpose than that, the stage 3 +-- build is usually omitted in the build process. +data Stage = Stage0 | Stage1 | Stage2 | Stage3 + deriving (Show, Eq, Ord, Enum, Generic, Bounded) + +instance Binary Stage +instance Hashable Stage +instance NFData Stage + From 799e5bda230ab98d838a59df353443c06d812aee Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 15:53:11 +0800 Subject: [PATCH 077/210] [Parsec Cabal] Adds Cabal/Cabal Dependencies --- cabal.project | 5 +++++ hadrian.cabal | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 1ef81ca2d0..e6f45b61d2 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,7 @@ packages: ../libraries/Cabal/Cabal/ + ../libraries/mtl/ + ../libraries/filepath/ + ../libraries/text/ + ../libraries/hpc/ + ../libraries/parsec/ ./ diff --git a/hadrian.cabal b/hadrian.cabal index 11123c392e..923a823914 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -127,7 +127,7 @@ executable hadrian , filepath , directory >= 1.2 && < 1.4 , extra >= 1.4.7 - , mtl == 2.2.* + , mtl , QuickCheck >= 2.6 && < 2.10 , shake == 0.16.* , transformers >= 0.4 && < 0.6 From 2d6bf90627a3f4c2dd7c5ee40a04c03641d4d0a5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 16:01:40 +0800 Subject: [PATCH 078/210] Meh --- cabal.project | 1 - hadrian.cabal | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index e6f45b61d2..84127017d2 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,4 @@ packages: ../libraries/Cabal/Cabal/ - ../libraries/mtl/ ../libraries/filepath/ ../libraries/text/ ../libraries/hpc/ diff --git a/hadrian.cabal b/hadrian.cabal index 923a823914..986d4772f3 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -27,7 +27,7 @@ executable hadrian , Expression , Flavour , GHC - , GHC.Package + , GHC.Packages , Hadrian.Builder , Hadrian.Builder.Ar , Hadrian.Builder.Sphinx From 8e83afd192fc0bb39c8214615702dc71a9fd970c Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 16:03:52 +0800 Subject: [PATCH 079/210] parseCabal now with Context --- src/Context.hs | 21 ++++++------ src/Expression.hs | 7 ++-- src/Hadrian/Haskell/Cabal.hs | 19 +++++------ src/Hadrian/Haskell/Cabal/Parse.hs | 51 ++++++++++++++++++++++-------- src/Hadrian/Oracles/TextFile.hs | 29 ++++++++--------- src/Rules/Library.hs | 2 +- src/Rules/Program.hs | 4 +-- src/Settings/Builders/Ghc.hs | 4 +-- src/Settings/Builders/GhcCabal.hs | 4 ++- src/Settings/Builders/Haddock.hs | 8 ++--- src/Settings/Default.hs | 10 +++--- src/Settings/Flavours/Quick.hs | 3 +- src/Settings/Packages/GhcCabal.hs | 4 ++- src/Utilities.hs | 5 ++- 14 files changed, 101 insertions(+), 70 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index 12a5219e82..daed19ed0e 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -48,18 +48,19 @@ getWay = way <$> getContext getStagedSettingList :: (Stage -> SettingList) -> Args Context b 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 +-- | Construct an expression that depends on the current package having +-- a Cabal file. For non haskell contexts it's empty. +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 + Just file -> expr ctx Nothing -> mempty -pkgId :: Package -> Action FilePath -pkgId package = case pkgCabalFile package of - Just file -> pkgIdentifier file +pkgId :: Context -> Action FilePath +pkgId context@Context {..} = case pkgCabalFile package of + Just file -> pkgIdentifier context Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts -- | The directroy in 'buildRoot' that will hold the final install artifact for a given 'Context'. @@ -74,7 +75,7 @@ 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'. @@ -124,9 +125,9 @@ pkgGhciLibraryFile context = pkgFile context "HS" ".o" -- | Path to the configuration file of a given 'Context'. pkgConfFile :: Context -> Action FilePath -pkgConfFile Context {..} = do +pkgConfFile context@Context {..} = do root <- buildRoot - pid <- pkgId package + pid <- pkgId context let dbDir | stage == Stage0 = root -/- stage0PackageDbDir | otherwise = root -/- inplacePackageDbPath stage return $ dbDir -/- pid <.> "conf" diff --git a/src/Expression.hs b/src/Expression.hs index 115a353333..4d75681a60 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -26,7 +26,7 @@ module Expression ( import qualified Hadrian.Expression as H import Hadrian.Expression hiding (Expr, Predicate, Args) import Hadrian.Haskell.Cabal.Parse (Cabal) -import Hadrian.Oracles.TextFile (readCabalFile') +import Hadrian.Oracles.TextFile (readCabalFile) import Base import Builder @@ -55,9 +55,8 @@ getPkgDataList key = expr . pkgDataList . key =<< getContextPath getCabalData :: (Cabal -> a) -> Expr a getCabalData key = do - stage <- getStage - path <- unsafePkgCabalFile <$> getPackage - cabal <- expr (readCabalFile' stage path) + ctx <- getContext + Just cabal <- expr (readCabalFile 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 2a3d4db7dc..e83816c606 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -14,6 +14,7 @@ module Hadrian.Haskell.Cabal ( ) where import Stage +import Types.Context import Development.Shake import Hadrian.Haskell.Cabal.Parse @@ -21,14 +22,14 @@ 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' Stage0 cabalFile +pkgVersion :: Context -> Action (Maybe String) +pkgVersion = fmap (fmap 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' Stage0 cabalFile +pkgIdentifier :: Context -> Action String +pkgIdentifier ctx = do + Just cabal <- readCabalFile ctx return $ if null (version cabal) then name cabal else name cabal ++ "-" ++ version cabal @@ -37,9 +38,9 @@ pkgIdentifier cabalFile = do -- 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 :: Stage -> FilePath -> Action [PackageName] -pkgDependencies stage cabalFile = dependencies <$> readCabalFile' stage cabalFile +pkgDependencies :: Context -> Action (Maybe [PackageName]) +pkgDependencies = fmap (fmap dependencies) . readCabalFile -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. -pkgSynopsis :: FilePath -> Action String -pkgSynopsis cabalFile = synopsis <$> readCabalFile' Stage0 cabalFile +pkgSynopsis :: Context -> Action (Maybe String) +pkgSynopsis = fmap (fmap synopsis) . readCabalFile diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 72c83b4433..f6832319c7 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -11,10 +11,11 @@ module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal, parseCabalPkgId, cabalCcArgs, cabalIncludeDirs) where import Stage +import Types.Context import {-# SOURCE #-} Builder hiding (Builder) -- import Hadrian.Builder as H import Data.List.Extra -import Development.Shake +import Development.Shake hiding (doesFileExist) import Development.Shake.Classes import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C @@ -25,10 +26,20 @@ import qualified Distribution.Types.CondTree as C import qualified Distribution.Verbosity as C import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.Program.Db as Db +import qualified Distribution.Simple as Hooks (simpleUserHooks, autoconfUserHooks) +import qualified Distribution.Simple.UserHooks as Hooks +import Distribution.Simple (defaultMainWithHooksNoReadArgs) import Distribution.Simple.Compiler (compilerInfo) import Hadrian.Package +import Hadrian.Utilities +import System.FilePath +import System.Directory import GHC.Generics +import GHC.Packages (rts) + +import Context.Paths + -- TODO: Use fine-grain tracking instead of tracking the whole Cabal file. -- | Haskell package metadata extracted from a Cabal file. data Cabal = Cabal @@ -61,32 +72,46 @@ cabalIncludeDirs c = concatMap C.includeDirs [ C.libBuildInfo lib | (Just lib) < --cabalDepIncludeDirs + +-- TODO: Taken from Context, but Context depends on Oracles.Settings, and this +-- would then lead to recursive imports. +contextPath :: Context -> Action FilePath +contextPath context = buildRoot <&> (-/- contextDir context) + +buildDir :: Context -> FilePath +buildDir context = contextDir context -/- "build" + -- | Parse a Cabal file. -parseCabal :: Stage -> FilePath -> Action Cabal -parseCabal stage file = do +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.silent file -- figure out what hooks we need. - let hooks = case buildType (flattenPackageDescription gpd) of - Just Configure -> autoconfUserHooks + hooks <- case C.buildType (C.flattenPackageDescription gpd) of + Just 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. - Just Custom -> - do configureExists <- doesFileExist (replaceFileName file "configure") + Just C.Custom -> + do configureExists <- liftIO $ doesFileExist (replaceFileName file "configure") if configureExists - then autoconfUserHooks - else simpleUserHooks + then pure Hooks.autoconfUserHooks + else pure Hooks.simpleUserHooks -- not quite right, but good enough for us: - _ | (pkgName . package . packageDescription $ gpd) == mkPackageName "rts" -> + _ | 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. - simpleUserHooks { postConf = \_ _ _ _ -> return () } - | otherwise -> simpleUserHooks + pure $ Hooks.simpleUserHooks { Hooks.postConf = \_ _ _ _ -> return () } + | otherwise -> pure Hooks.simpleUserHooks - defaultMainWithHooksNoReadArgs hooks gpd ["configure", "--distdir", undefined, "--ipid", "$pkg-$version"] + bPath <- buildPath context + liftIO $ + withCurrentDirectory (pkgPath package) $ + defaultMainWithHooksNoReadArgs hooks gpd ["configure", "--distdir", bPath, "--ipid", "$pkg-$version"] hcPath <- builderPath' (Ghc CompileHs stage) (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index fb0889a5a4..f6593790fc 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -13,10 +13,12 @@ module Hadrian.Oracles.TextFile ( readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, - readCabalFile, readCabalFile', textFileOracle + readCabalFile, textFileOracle ) where import Stage +import Types.Context +import Hadrian.Package import Control.Monad import qualified Data.HashMap.Strict as Map @@ -32,7 +34,7 @@ newtype TextFile = TextFile FilePath deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult TextFile = String -newtype CabalFile = CabalFile (Stage, FilePath) +newtype CabalFile = CabalFile Context deriving (Binary, Eq, Hashable, NFData, Show, Typeable) type instance RuleResult CabalFile = Maybe Cabal @@ -92,11 +94,8 @@ lookupDependencies depFile file = do Just (source : files) -> return (source, files) -- | Read and parse a @.cabal@ file, caching and tracking the result. -readCabalFile :: Stage -> FilePath -> Action (Maybe Cabal) -readCabalFile stage file = askOracle $ CabalFile (stage, file) - -readCabalFile' :: Stage -> FilePath -> Action Cabal -readCabalFile' stage file = fromJust <$> readCabalFile stage file +readCabalFile :: Context -> Action (Maybe Cabal) +readCabalFile = askOracle . CabalFile -- | This oracle reads and parses text files to answer 'readTextFile' and -- 'lookupValue' queries, as well as their derivatives, tracking the results. @@ -121,12 +120,12 @@ textFileOracle = do return $ Map.fromList [ (key, values) | (key:values) <- contents ] void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file - cabalMap <- fmap Map.fromList . forM [Stage0 ..] $ \stage -> do - cabal <- newCache $ \file -> do + cabal <- newCache $ \(ctx@Context {..}) -> do + case pkgCabalFile package of + Just file -> do need [file] - putLoud $ "| CabalFile oracle: reading " ++ quote file ++ "..." - parseCabal stage file - return (stage, cabal) - void $ addOracle $ \(CabalFile (stage, file)) -> case Map.lookup stage cabalMap of - Just cabal -> Just <$> cabal file - Nothing -> return $ Nothing + putLoud $ "| CabalFile oracle: reading " ++ quote file ++ " (Stage: " ++ stageString stage ++ ")..." + Just <$> parseCabal ctx + Nothing -> return Nothing + + void $ addOracle $ \(CabalFile ctx) -> cabal ctx diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index a313393846..16242e9027 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -95,7 +95,7 @@ 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 diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 97c060311c..f35ba4279e 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -111,7 +111,7 @@ buildBinary rs bin context@Context {..} = do -- -- As such, we will ignore this for now, even though it will mean -- -- that hadrian will not properly track the dependencies of -- -- ghc-cabal properly. - + -- ghcCabalPath <- contextPath (context { Context.package = ghcCabal }) -- cabalPath <- contextPath (context { Context.package = cabal }) -- textPath <- contextPath (context { Context.package = text }) @@ -133,6 +133,6 @@ buildBinary rs bin context@Context {..} = do ++ [ path -/- "build" -/- "Paths_haddock.o" | package == haddock ] 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/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index a9e9d9da07..48299ff0c9 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -126,8 +126,8 @@ 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 diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index c3700abd89..1461d9de85 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -7,6 +7,7 @@ import Hadrian.Haskell.Cabal import Context import Flavour import Settings.Builders.Common +import qualified Types.Context as Context ghcCabalBuilderArgs :: Args ghcCabalBuilderArgs = mconcat @@ -103,8 +104,9 @@ 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 ] diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index b3810476ad..a96299ff31 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -14,7 +14,7 @@ versionToInt s = case map read . words $ replaceEq '.' ' ' s of _ -> error "versionToInt: cannot parse version." haddockBuilderArgs :: Args -haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat +haddockBuilderArgs = withHsPackage $ \ctx -> mconcat [ builder (Haddock BuildIndex) ? do output <- getOutput inputs <- getInputs @@ -32,11 +32,11 @@ haddockBuilderArgs = withHsPackage $ \cabalFile -> mconcat output <- getOutput pkg <- getPackage path <- getBuildPath - version <- expr $ pkgVersion cabalFile - synopsis <- expr $ pkgSynopsis cabalFile + Just version <- expr $ pkgVersion ctx + Just synopsis <- expr $ pkgSynopsis ctx deps <- getPkgDataList DepNames haddocks <- expr . haddockDependencies =<< getContext - hVersion <- expr $ pkgVersion (unsafePkgCabalFile haddock) -- TODO: improve + Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs mconcat [ arg $ "--odir=" ++ takeDirectory output diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index b9d0d7dc64..113d313178 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -97,7 +97,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 @@ -106,9 +107,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 ] + ] -- | Default build flavour. Other build flavours are defined in modules -- @Settings.Flavours.*@. Users can add new build flavours in "UserSettings". diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs index 266d3e3869..3d839ee615 100644 --- a/src/Settings/Flavours/Quick.hs +++ b/src/Settings/Flavours/Quick.hs @@ -11,7 +11,8 @@ quickFlavour = defaultFlavour , args = defaultBuilderArgs <> quickArgs <> defaultPackageArgs , libraryWays = mconcat [ pure [vanilla] - , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] } + -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] + ] } quickArgs :: Args quickArgs = sourceArgs SourceArgs diff --git a/src/Settings/Packages/GhcCabal.hs b/src/Settings/Packages/GhcCabal.hs index d0c30cd0fc..2449646d2d 100644 --- a/src/Settings/Packages/GhcCabal.hs +++ b/src/Settings/Packages/GhcCabal.hs @@ -5,11 +5,13 @@ import Hadrian.Haskell.Cabal import Base import Expression import Utilities +import qualified Types.Context as Context ghcCabalPackageArgs :: Args ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do cabalDeps <- expr $ stage1Dependencies cabal - cabalVersion <- expr $ pkgVersion (unsafePkgCabalFile cabal) -- TODO: improve + ctx <- getContext + Just cabalVersion <- expr $ pkgVersion (ctx { Context.package = cabal }) -- TODO: improve mconcat [ pure [ "-package " ++ pkgName pkg | pkg <- cabalDeps, pkg /= parsec ] , arg "--make" diff --git a/src/Utilities.hs b/src/Utilities.hs index 7a98e7320c..6d57eb4909 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -37,12 +37,11 @@ ask target = H.ask target getArgs -- dependencies we scan package @.cabal@ files, see 'pkgDependencies' defined -- in "Hadrian.Haskell.Cabal". contextDependencies :: Context -> Action [Context] -contextDependencies Context {..} = case pkgCabalFile package of +contextDependencies ctx@Context {..} = pkgDependencies ctx >>= \case Nothing -> return [] -- Non-Cabal packages have no dependencies. - Just cabalFile -> do + Just deps -> do let depStage = min stage Stage1 depContext = \pkg -> Context depStage pkg way - deps <- pkgDependencies stage cabalFile pkgs <- sort <$> stagePackages depStage return . map depContext $ intersectOrd (compare . pkgName) pkgs deps From efc8bc7abe35a15b7d791142a34ca468914d3864 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 3 Nov 2017 22:44:54 +0800 Subject: [PATCH 080/210] Integrating ghc-cabal, part 1 --- src/Hadrian/Haskell/Cabal/Parse.hs | 39 ++++++++++++++++++++++++------ src/Oracles/ModuleFiles.hs | 10 +++++--- src/Rules/Library.hs | 4 +-- src/Rules/Program.hs | 3 ++- 4 files changed, 42 insertions(+), 14 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index f6832319c7..68705106ba 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -8,7 +8,12 @@ -- -- Extracting Haskell package metadata stored in Cabal files. ----------------------------------------------------------------------------- -module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal, parseCabalPkgId, cabalCcArgs, cabalIncludeDirs) where +module Hadrian.Haskell.Cabal.Parse ( Cabal (..) + , parseCabal, parseCabalPkgId + , cabalCcArgs, cabalIncludeDirs, cabalCSrcs + , cabalModules, cabalOtherModules + , cabalSrcDirs, cabalCmmSrcs + ) where import Stage import Types.Context @@ -28,6 +33,7 @@ import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.Program.Db as Db import qualified Distribution.Simple as Hooks (simpleUserHooks, autoconfUserHooks) import qualified Distribution.Simple.UserHooks as Hooks +import Distribution.Text (display) import Distribution.Simple (defaultMainWithHooksNoReadArgs) import Distribution.Simple.Compiler (compilerInfo) import Hadrian.Package @@ -35,7 +41,8 @@ import Hadrian.Utilities import System.FilePath import System.Directory import GHC.Generics - +import qualified Distribution.ModuleName as ModuleName +import Data.Maybe (maybeToList) import GHC.Packages (rts) import Context.Paths @@ -61,15 +68,33 @@ instance NFData Cabal where parseCabalPkgId :: FilePath -> IO String parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file -cabalCcArgs :: Cabal -> [String] -cabalCcArgs c = concatMap C.ccOptions [ C.libBuildInfo lib | (Just lib) <- [C.library (packageDesc c)] - , C.buildable . C.libBuildInfo $ lib ] +biModules :: Cabal -> (C.BuildInfo, [ModuleName.ModuleName]) +biModules c = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.library (packageDesc c)) + ++ (map exeBiModules $ C.executables (packageDesc c)) + , C.buildable bi ] + where libBiModules lib = (C.libBuildInfo lib, C.libModules lib) + exeBiModules exe = (C.buildInfo exe, ModuleName.main : C.exeModules exe) + go [] = error "no buildable component found" + go [x] = x + go _ = error "can not handle more than one buildinfo yet!" +cabalCcArgs :: Cabal -> [String] +cabalCcArgs c = C.ccOptions (fst (biModules c)) +cabalCSrcs :: Cabal -> [String] +cabalCSrcs c = C.cSources (fst (biModules c)) +cabalCmmSrcs :: Cabal -> [String] +cabalCmmSrcs c = C.cmmSources (fst (biModules c)) cabalIncludeDirs :: Cabal -> [String] -cabalIncludeDirs c = concatMap C.includeDirs [ C.libBuildInfo lib | (Just lib) <- [C.library (packageDesc c)] - , C.buildable . C.libBuildInfo $ lib ] +cabalIncludeDirs c = C.includeDirs (fst (biModules c)) +cabalModules :: Cabal -> [String] +cabalModules c = map display $ snd (biModules c) + +cabalSrcDirs :: Cabal -> [String] +cabalSrcDirs c = C.hsSourceDirs $ fst (biModules c) +cabalOtherModules :: Cabal -> [String] +cabalOtherModules c = map display $ C.otherModules (fst (biModules c)) --cabalDepIncludeDirs diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index 2ea85f403f..1284380132 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -10,6 +10,8 @@ import Builder import Context import GHC import Oracles.PackageData +import Expression +import Hadrian.Haskell.Cabal.Parse newtype ModuleFiles = ModuleFiles (Stage, Package) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -89,7 +91,7 @@ hsSources context = do hsObjects :: Context -> Action [FilePath] hsObjects context = do path <- contextPath context - modules <- pkgDataList (Modules path) + modules <- interpretInContext context (getCabalData cabalModules) -- GHC.Prim module is only for documentation, we do not actually build it. mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules) @@ -106,7 +108,7 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" contextFiles :: Context -> Action [(String, Maybe FilePath)] contextFiles context@Context {..} = do path <- contextPath context - modules <- fmap sort . pkgDataList $ Modules path + modules <- fmap sort $ interpretInContext context (getCabalData cabalModules) zip modules <$> askOracle (ModuleFiles (stage, package)) -- | This is an important oracle whose role is to find and cache module source @@ -125,8 +127,8 @@ moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package path <- contextPath context - srcDirs <- pkgDataList $ SrcDirs path - modules <- fmap sort . pkgDataList $ Modules path + srcDirs <- interpretInContext context (getCabalData cabalSrcDirs) + modules <- fmap sort $ interpretInContext context (getCabalData cabalModules) autogen <- autogenPath context let dirs = autogen : map (pkgPath package -/-) srcDirs modDirFiles = groupSort $ map decodeModule modules diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 16242e9027..e016cd853b 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -122,7 +122,7 @@ nonHsObjects :: Context -> Action [FilePath] nonHsObjects context = do path <- contextPath context cObjs <- cObjects context - cmmSrcs <- pkgDataList (CmmSrcs path) + cmmSrcs <- interpretInContext context (getCabalData cabalCmmSrcs) cmmObjs <- mapM (objectPath context) cmmSrcs eObjs <- extraObjects context return $ cObjs ++ cmmObjs ++ eObjs @@ -130,7 +130,7 @@ nonHsObjects context = do cObjects :: Context -> Action [FilePath] cObjects context = do path <- contextPath context - srcs <- pkgDataList (CSrcs path) + srcs <- interpretInContext context (getCabalData cabalCSrcs) 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 f35ba4279e..ac67517393 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -1,6 +1,7 @@ module Rules.Program (buildProgram) where import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Parse import Base import Context @@ -125,7 +126,7 @@ buildBinary rs bin context@Context {..} = do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ rtsContext { way = w } | w <- ways ] path <- contextPath context - cSrcs <- pkgDataList (CSrcs path) + cSrcs <- interpretInContext context (getCabalData cabalCSrcs) cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs From 19d984bff18df768d3dc93590086019dc836e678 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 4 Nov 2017 13:59:56 +0800 Subject: [PATCH 081/210] [Package Data] DEP_LIB_DIR I'm unable to find any reference in the ghc source tree wrt DEP_LIB_DIRS_SINGLE_QUOTED --- src/Oracles/PackageData.hs | 2 -- src/Settings/Builders/Ghc.hs | 2 -- src/Settings/Builders/Hsc2Hs.hs | 2 -- 3 files changed, 6 deletions(-) diff --git a/src/Oracles/PackageData.hs b/src/Oracles/PackageData.hs index cdfe9bfb48..feaa3326ac 100644 --- a/src/Oracles/PackageData.hs +++ b/src/Oracles/PackageData.hs @@ -18,7 +18,6 @@ data PackageDataList = AsmSrcs FilePath | DepIds FilePath | DepIncludeDirs FilePath | DepLdArgs FilePath - | DepLibDirs FilePath | DepNames FilePath | Deps FilePath | HiddenModules FilePath @@ -52,7 +51,6 @@ pkgDataList packageData = fmap (map unquote . words) $ case packageData of 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" diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 48299ff0c9..e1af08edc0 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -49,7 +49,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do way <- getWay pkg <- getPackage libs <- getPkgDataList DepExtraLibs - libDirs <- getPkgDataList DepLibDirs intLib <- expr (integerLibrary =<< flavour) gmpLibs <- if stage > Stage0 && intLib == integerGmp then do -- TODO: get this data more gracefully @@ -63,7 +62,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , 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 ] ] splitObjectsArgs :: Args splitObjectsArgs = splitObjects <$> flavour ? do diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 8fafc628ba..811375691a 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -47,11 +47,9 @@ getCFlags = do getLFlags :: Expr [String] getLFlags = do - libDirs <- getPkgDataList DepLibDirs extraLibs <- getPkgDataList DepExtraLibs mconcat [ getStagedSettingList ConfGccLinkerArgs , ldArgs , getPkgDataList LdArgs - , pure [ "-L" ++ unifyPath dir | dir <- libDirs ] , pure [ "-l" ++ unifyPath dir | dir <- extraLibs ] , getPkgDataList DepLdArgs ] From 011ea7acbec1097e90f1c770a90d0628fbd7079e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 5 Nov 2017 13:57:24 +0800 Subject: [PATCH 082/210] Move Way into TYpes --- src/Types/Way.hs | 112 +++++++++++++++++++++++++++++++++++++++++++++++ src/Way.hs | 106 +------------------------------------------- 2 files changed, 113 insertions(+), 105 deletions(-) create mode 100644 src/Types/Way.hs diff --git a/src/Types/Way.hs b/src/Types/Way.hs new file mode 100644 index 0000000000..69d12fe3d6 --- /dev/null +++ b/src/Types/Way.hs @@ -0,0 +1,112 @@ +module Types.Way where +import Development.Shake.Classes +import Data.IntSet (IntSet) +import qualified Data.IntSet as Set +import Data.List +import Hadrian.Utilities +import Data.Maybe + +-- Note: order of constructors is important for compatibility with the old build +-- system, e.g. we want "thr_p", not "p_thr" (see instance Show Way). +-- | A 'WayUnit' is a single way of building source code, for example with +-- profiling enabled, or dynamically linked. +data WayUnit = Threaded + | Debug + | Profiling + | Logging + | Dynamic + deriving (Bounded, Enum, Eq, Ord) + +-- TODO: get rid of non-derived Show instances +instance Show WayUnit where + show unit = case unit of + Threaded -> "thr" + Debug -> "debug" + Profiling -> "p" + Logging -> "l" + Dynamic -> "dyn" + +instance Read WayUnit where + readsPrec _ s = [(unit, "") | unit <- [minBound ..], show unit == s] + +-- | Collection of 'WayUnit's that stands for the different ways source code +-- is to be built. +newtype Way = Way IntSet + +instance Binary Way where + put = put . show + get = fmap read get + +instance Hashable Way where + hashWithSalt salt = hashWithSalt salt . show + +instance NFData Way where + rnf (Way s) = s `seq` () + +-- | Construct a 'Way' from multiple 'WayUnit's. Inverse of 'wayToUnits'. +wayFromUnits :: [WayUnit] -> Way +wayFromUnits = Way . Set.fromList . map fromEnum + +-- | Split a 'Way' into its 'WayUnit' building blocks. +-- Inverse of 'wayFromUnits'. +wayToUnits :: Way -> [WayUnit] +wayToUnits (Way set) = map toEnum . Set.elems $ set + +-- | Check whether a 'Way' contains a certain 'WayUnit'. +wayUnit :: WayUnit -> Way -> Bool +wayUnit unit (Way set) = fromEnum unit `Set.member` set + +-- | Remove a 'WayUnit' from 'Way'. +removeWayUnit :: WayUnit -> Way -> Way +removeWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set + +instance Show Way where + show way = if null tag then "v" else tag + where + tag = intercalate "_" . map show . wayToUnits $ way + +instance Read Way where + readsPrec _ s = if s == "v" then [(vanilla, "")] else result + where + uniqueReads token = case reads token of + [(unit, "")] -> Just unit + _ -> Nothing + units = map uniqueReads . words . replaceEq '_' ' ' $ s + result = if Nothing `elem` units + then [] + else [(wayFromUnits . map fromJust $ units, "")] + +instance Eq Way where + Way a == Way b = a == b + +instance Ord Way where + compare (Way a) (Way b) = compare a b + +-- | Build default _vanilla_ way. +vanilla :: Way +vanilla = wayFromUnits [] + +-- | Build with profiling. +profiling :: Way +profiling = wayFromUnits [Profiling] + +-- | Build with dynamic linking. +dynamic :: Way +dynamic = wayFromUnits [Dynamic] + +-- | Build with profiling and dynamic linking. +profilingDynamic :: Way +profilingDynamic = wayFromUnits [Profiling, Dynamic] + +-- RTS only ways below. See compiler/main/DynFlags.hs. +-- | Build RTS with event logging. +logging :: Way +logging = wayFromUnits [Logging] + +-- | Build multithreaded RTS. +threaded :: Way +threaded = wayFromUnits [Threaded] + +-- | Build RTS with debug information. +debug :: Way +debug = wayFromUnits [Debug] diff --git a/src/Way.hs b/src/Way.hs index e904d93cbc..6fabb313d9 100644 --- a/src/Way.hs +++ b/src/Way.hs @@ -15,111 +15,7 @@ import Data.List import Data.Maybe import Development.Shake.Classes import Hadrian.Utilities - --- Note: order of constructors is important for compatibility with the old build --- system, e.g. we want "thr_p", not "p_thr" (see instance Show Way). --- | A 'WayUnit' is a single way of building source code, for example with --- profiling enabled, or dynamically linked. -data WayUnit = Threaded - | Debug - | Profiling - | Logging - | Dynamic - deriving (Bounded, Enum, Eq, Ord) - --- TODO: get rid of non-derived Show instances -instance Show WayUnit where - show unit = case unit of - Threaded -> "thr" - Debug -> "debug" - Profiling -> "p" - Logging -> "l" - Dynamic -> "dyn" - -instance Read WayUnit where - readsPrec _ s = [(unit, "") | unit <- [minBound ..], show unit == s] - --- | Collection of 'WayUnit's that stands for the different ways source code --- is to be built. -newtype Way = Way IntSet - -instance Binary Way where - put = put . show - get = fmap read get - -instance Hashable Way where - hashWithSalt salt = hashWithSalt salt . show - -instance NFData Way where - rnf (Way s) = s `seq` () - --- | Construct a 'Way' from multiple 'WayUnit's. Inverse of 'wayToUnits'. -wayFromUnits :: [WayUnit] -> Way -wayFromUnits = Way . Set.fromList . map fromEnum - --- | Split a 'Way' into its 'WayUnit' building blocks. --- Inverse of 'wayFromUnits'. -wayToUnits :: Way -> [WayUnit] -wayToUnits (Way set) = map toEnum . Set.elems $ set - --- | Check whether a 'Way' contains a certain 'WayUnit'. -wayUnit :: WayUnit -> Way -> Bool -wayUnit unit (Way set) = fromEnum unit `Set.member` set - --- | Remove a 'WayUnit' from 'Way'. -removeWayUnit :: WayUnit -> Way -> Way -removeWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set - -instance Show Way where - show way = if null tag then "v" else tag - where - tag = intercalate "_" . map show . wayToUnits $ way - -instance Read Way where - readsPrec _ s = if s == "v" then [(vanilla, "")] else result - where - uniqueReads token = case reads token of - [(unit, "")] -> Just unit - _ -> Nothing - units = map uniqueReads . words . replaceEq '_' ' ' $ s - result = if Nothing `elem` units - then [] - else [(wayFromUnits . map fromJust $ units, "")] - -instance Eq Way where - Way a == Way b = a == b - -instance Ord Way where - compare (Way a) (Way b) = compare a b - --- | Build default _vanilla_ way. -vanilla :: Way -vanilla = wayFromUnits [] - --- | Build with profiling. -profiling :: Way -profiling = wayFromUnits [Profiling] - --- | Build with dynamic linking. -dynamic :: Way -dynamic = wayFromUnits [Dynamic] - --- | Build with profiling and dynamic linking. -profilingDynamic :: Way -profilingDynamic = wayFromUnits [Profiling, Dynamic] - --- RTS only ways below. See compiler/main/DynFlags.hs. --- | Build RTS with event logging. -logging :: Way -logging = wayFromUnits [Logging] - --- | Build multithreaded RTS. -threaded :: Way -threaded = wayFromUnits [Threaded] - --- | Build RTS with debug information. -debug :: Way -debug = wayFromUnits [Debug] +import Types.Way -- | Various combinations of RTS only ways. threadedDebug, threadedProfiling, threadedLogging, threadedDynamic, From afac41cf76d424789e71cbb7c40759df2aec9ebf Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 5 Nov 2017 13:57:52 +0800 Subject: [PATCH 083/210] Move Expression into Types --- src/Expression.hs | 12 +----------- src/Types/Expression.hs | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+), 11 deletions(-) create mode 100644 src/Types/Expression.hs diff --git a/src/Expression.hs b/src/Expression.hs index 4d75681a60..1c1ce74201 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -27,6 +27,7 @@ import qualified Hadrian.Expression as H import Hadrian.Expression hiding (Expr, Predicate, Args) import Hadrian.Haskell.Cabal.Parse (Cabal) import Hadrian.Oracles.TextFile (readCabalFile) +import Types.Expression import Base import Builder @@ -34,17 +35,6 @@ import GHC import Context hiding (stage, package, way) import Oracles.PackageData --- | @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 - --- | The following expressions are used throughout the build system for --- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways' --- and 'Packages'. -type Predicate = H.Predicate Context Builder -type Args = H.Args Context Builder -type Ways = Expr [Way] - -- | Get a value from the @package-data.mk@ file of the current context. getPkgData :: (FilePath -> PackageData) -> Expr String getPkgData key = expr . pkgData . key =<< getContextPath diff --git a/src/Types/Expression.hs b/src/Types/Expression.hs new file mode 100644 index 0000000000..ddca009bae --- /dev/null +++ b/src/Types/Expression.hs @@ -0,0 +1,18 @@ +module Types.Expression where + +import Types.Context +import Types.Way + +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 + +-- | The following expressions are used throughout the build system for +-- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways' +-- and 'Packages'. +type Predicate = H.Predicate Context Builder +type Args = H.Args Context Builder +type Ways = Expr [Way] + From 44e1988338bc41a1e3adba35a9cda1488f3ca4c0 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 09:32:54 +0800 Subject: [PATCH 084/210] Adds CabalFlags builder. A virtual builder to collect flags. --- src/Builder.hs | 2 ++ src/Builder.hs-boot | 1 + 2 files changed, 3 insertions(+) diff --git a/src/Builder.hs b/src/Builder.hs index c03d3b3dd9..0e1cd2d37f 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -110,6 +110,8 @@ 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 diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index ce271056e6..fc862478f7 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -37,5 +37,6 @@ data Builder = Alex | Tar TarMode | Unlit | Xelatex + | CabalFlags Stage builderPath' :: Builder -> Action FilePath \ No newline at end of file From b16999a1dae496214e71fe276e578af2fe007a62 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 09:34:04 +0800 Subject: [PATCH 085/210] Packages provide flags via the flags builder. --- src/Settings/Packages/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Packages/Base.hs b/src/Settings/Packages/Base.hs index c8ef887e25..42209a49f1 100644 --- a/src/Settings/Packages/Base.hs +++ b/src/Settings/Packages/Base.hs @@ -6,7 +6,7 @@ import Settings basePackageArgs :: Args basePackageArgs = package base ? do integerLibrary <- expr integerLibraryName - mconcat [ builder (GhcCabal Conf) ? arg ("--flags=" ++ integerLibrary) + mconcat [ builder CabalFlags ? arg ('+':integerLibrary) -- This fixes the 'unknown symbol stat' issue. -- See: https://github.com/snowleopard/hadrian/issues/259. , builder (Ghc CompileCWithGhc) ? arg "-optc-O2" ] From 649f455da63baa6d628ec8259e352b80f31af631 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 09:36:37 +0800 Subject: [PATCH 086/210] Cabal and Configured Cabal logic. --- src/Hadrian/Haskell/Cabal/Parse.hs | 162 ++++++++++++++++++++++++----- src/Types/Cabal.hs | 24 +++++ src/Types/ConfiguredCabal.hs | 54 ++++++++++ 3 files changed, 212 insertions(+), 28 deletions(-) create mode 100644 src/Types/Cabal.hs create mode 100644 src/Types/ConfiguredCabal.hs diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 68705106ba..a8119aaf16 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -44,34 +44,23 @@ import GHC.Generics import qualified Distribution.ModuleName as ModuleName import Data.Maybe (maybeToList) import GHC.Packages (rts) +import Types.Cabal ( Cabal( Cabal ) ) +import Types.ConfiguredCabal import Context.Paths --- 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 - , packageDesc :: C.PackageDescription - } deriving (Eq, Read, Show, Typeable, Generic) instance Binary Cabal -instance Hashable Cabal where - hashWithSalt salt = hashWithSalt salt . show -instance NFData Cabal where - rnf (Cabal a b c d e) = a `seq` b `seq` c `seq` d `seq` e `seq` () parseCabalPkgId :: FilePath -> IO String parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file -biModules :: Cabal -> (C.BuildInfo, [ModuleName.ModuleName]) -biModules c = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.library (packageDesc c)) - ++ (map exeBiModules $ C.executables (packageDesc c)) +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.libModules lib) exeBiModules exe = (C.buildInfo exe, ModuleName.main : C.exeModules exe) @@ -106,7 +95,6 @@ contextPath context = buildRoot <&> (-/- contextDir context) buildDir :: Context -> FilePath buildDir context = contextDir context -/- "build" --- | Parse a Cabal file. parseCabal :: Context -> Action Cabal parseCabal context@Context {..} = do let (Just file) = pkgCabalFile package @@ -114,6 +102,31 @@ parseCabal context@Context {..} = do -- read the package description from the cabal file gpd <- liftIO $ C.readGenericPackageDescription C.silent 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) [] []) defaultPackageArgs + 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 (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) . C.buildDepends $ 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 -- figure out what hooks we need. hooks <- case C.buildType (C.flattenPackageDescription gpd) of Just C.Configure -> pure Hooks.autoconfUserHooks @@ -140,18 +153,111 @@ parseCabal context@Context {..} = do hcPath <- builderPath' (Ghc CompileHs stage) (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb +-- | Parse a ConfiguredCabal file. +parseConfiguredCabal :: Context -> Action ConfiguredCabal +parseConfiguredCabal context@Context {..} = do + + Just (Cabal _ _ _ gpd pd depPkgs) <- readCabalFile context + + -- XXX: need the setup-config here, which would trigger the configure Package + configurePackage context + + cPath <- Context.contextPath context + liftIO $ putStrLn $ "trying to obtain the persitendBuildConfig at " ++ show cPath + 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). + liftIO $ C.initialBuildSteps cPath pd lbi C.silent + + let extDeps = C.externalPackageDeps lbi + deps = map (display . snd) extDeps + dep_direct = map (fromMaybe (error "dep_keys failed") + . PackageIndex.lookupUnitId (C.installedPkgs lbi) + . fst) extDeps + dep_ipids = map (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 compilerFlavor (C.compiler lbi) of + 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 = + 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!!" - let (Right (pd,_)) = C.finalizePackageDescription mempty (const True) platform (compilerInfo compiler) [] gpd - 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 pd + wrap = map wrap1 + wrap1 s + | null s = error $ "Wrapping empty value" + | '\'' `elem` s = error $ "Single quote in value to be wrapped:" ++ s + -- We want to be able to assume things like is the + -- start of a value, so check there are no spaces in confusing + -- positions + | head s == ' ' = error "Leading space in value to be wrapped:" ++ s + | last s == ' ' = error "Trailing space in value to be wrapped:" ++ s + | otherwise = ("\'" ++ s ++ "\'") + 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 + , 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 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 = wrap $ forDeps Installed.includeDirs + , depCcOpts = forDeps Installed.ccOptions + , depLdOpts = forDeps Installed.ldOptions + , buildGhciLib = C.withGHCiLib lbi + } + where collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency] collectDeps Nothing = [] diff --git a/src/Types/Cabal.hs b/src/Types/Cabal.hs new file mode 100644 index 0000000000..0f4c6cab0a --- /dev/null +++ b/src/Types/Cabal.hs @@ -0,0 +1,24 @@ +module Types.Cabal where + +import Development.Shake.Classes +import Types.Package +import GHC.Generics +import Distribution.PackageDescription (GenericPackageDescription, PackageDescription) + +data Cabal = Cabal + { name :: PackageName + , version :: String + , synopsis :: String + , genericPackageDescription :: GenericPackageDescription + , packageDescription :: PackageDescription -- ^ the configured generic package description + , packageDependencies :: [Package] + } deriving (Eq, Show, Typeable, Generic) + +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` () diff --git a/src/Types/ConfiguredCabal.hs b/src/Types/ConfiguredCabal.hs new file mode 100644 index 0000000000..c65f7823de --- /dev/null +++ b/src/Types/ConfiguredCabal.hs @@ -0,0 +1,54 @@ +module Types.ConfiguredCabal where + +import Development.Shake.Classes +import Types.Package +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 + , 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) + = 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` () From 9b3853566394dfc8aa2fd3fe322d7ce6155f28f8 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 09:37:02 +0800 Subject: [PATCH 087/210] break retain cycles. --- src/Hadrian/Haskell/Cabal/Parse.hs-boot | 9 +++++++++ src/Hadrian/Oracles/TextFile.hs | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) create mode 100644 src/Hadrian/Haskell/Cabal/Parse.hs-boot diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs-boot b/src/Hadrian/Haskell/Cabal/Parse.hs-boot new file mode 100644 index 0000000000..20aaf7e9f4 --- /dev/null +++ b/src/Hadrian/Haskell/Cabal/Parse.hs-boot @@ -0,0 +1,9 @@ +module Hadrian.Haskell.Cabal.Parse where + +import Types.Context +import Types.Cabal (Cabal) +import Types.ConfiguredCabal (ConfiguredCabal) +import Development.Shake + +parseCabal :: Context -> Action Cabal +parseConfiguredCabal :: Context -> Action ConfiguredCabal \ No newline at end of file diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index f6593790fc..860becd507 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -27,7 +27,7 @@ import Development.Shake import Development.Shake.Classes import Development.Shake.Config -import Hadrian.Haskell.Cabal.Parse +import {-# SOURCE #-} Hadrian.Haskell.Cabal.Parse import Hadrian.Utilities newtype TextFile = TextFile FilePath From acc5e7bace44485c0f9c2c14a645a58856dc13bf Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 09:37:21 +0800 Subject: [PATCH 088/210] Adds Configured Cabal Oracle logic. --- src/Hadrian/Oracles/TextFile.hs | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index 860becd507..b76528d34c 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -13,11 +13,13 @@ module Hadrian.Oracles.TextFile ( readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, - readCabalFile, textFileOracle + readCabalFile, readConfiguredCabalFile, textFileOracle ) where import Stage import Types.Context +import Types.Cabal +import Types.ConfiguredCabal import Hadrian.Package import Control.Monad @@ -38,6 +40,10 @@ newtype CabalFile = CabalFile Context deriving (Binary, Eq, Hashable, NFData, Show, Typeable) 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) type instance RuleResult KeyValue = Maybe String @@ -97,6 +103,9 @@ lookupDependencies depFile file = do 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 () @@ -129,3 +138,13 @@ textFileOracle = do 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 From 615192d8035293bcfe8f345b0eebaad19345f2f5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 09:38:32 +0800 Subject: [PATCH 089/210] [roll ghc-cabal into hadrian] configure, copy, register logic. --- src/Hadrian/Haskell/Cabal/Parse.hs | 194 ++++++++++++++++++++++++----- 1 file changed, 161 insertions(+), 33 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index a8119aaf16..476d250163 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -8,11 +8,12 @@ -- -- Extracting Haskell package metadata stored in Cabal files. ----------------------------------------------------------------------------- -module Hadrian.Haskell.Cabal.Parse ( Cabal (..) - , parseCabal, parseCabalPkgId - , cabalCcArgs, cabalIncludeDirs, cabalCSrcs - , cabalModules, cabalOtherModules - , cabalSrcDirs, cabalCmmSrcs +module Hadrian.Haskell.Cabal.Parse ( ConfiguredCabal (..) + , parseCabal, parseConfiguredCabal, parseCabalPkgId + + -- XXX This should be Haskell.Cabal actually + , configurePackage, copyPackage, registerPackage + ) where import Stage @@ -28,13 +29,25 @@ import qualified Distribution.PackageDescription.Parse as C import qualified Distribution.PackageDescription.Configuration as C import qualified Distribution.Text as C import qualified Distribution.Types.CondTree as C +import qualified Distribution.Types.Dependency as C +import qualified Distribution.Types.MungedPackageId as C (mungedName) import qualified Distribution.Verbosity as C +import qualified Distribution.Simple.Compiler as C (packageKeySupported, languageToFlags, extensionsToFlags) import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.Program.Db as Db import qualified Distribution.Simple as Hooks (simpleUserHooks, autoconfUserHooks) import qualified Distribution.Simple.UserHooks as Hooks +import qualified Distribution.Simple.Program.Builtin as C +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.InstalledPackageInfo as Installed +import qualified Distribution.Simple.PackageIndex as PackageIndex +import qualified Distribution.Simple.LocalBuildInfo as LBI +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) +import qualified Distribution.Types.LocalBuildInfo as C import Distribution.Text (display) -import Distribution.Simple (defaultMainWithHooksNoReadArgs) +import Distribution.Simple (defaultMainWithHooksNoReadArgs, compilerFlavor, CompilerFlavor( GHC )) import Distribution.Simple.Compiler (compilerInfo) import Hadrian.Package import Hadrian.Utilities @@ -42,17 +55,29 @@ import System.FilePath import System.Directory import GHC.Generics import qualified Distribution.ModuleName as ModuleName -import Data.Maybe (maybeToList) +import Data.Maybe (maybeToList, fromMaybe, fromJust) import GHC.Packages (rts) +import Hadrian.Expression +import Hadrian.Target import Types.Cabal ( Cabal( Cabal ) ) import Types.ConfiguredCabal +import Settings +import Oracles.Setting + +import Hadrian.Haskell.Cabal + import Context.Paths +import Settings.Builders.GhcCabal +import Settings.Default +import Context -instance Binary Cabal +import Hadrian.Oracles.TextFile +-- TODO: Use fine-grain tracking instead of tracking the whole Cabal file. +-- | Haskell package metadata extracted from a Cabal file. parseCabalPkgId :: FilePath -> IO String parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file @@ -68,24 +93,6 @@ biModules pd = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.li go [x] = x go _ = error "can not handle more than one buildinfo yet!" -cabalCcArgs :: Cabal -> [String] -cabalCcArgs c = C.ccOptions (fst (biModules c)) -cabalCSrcs :: Cabal -> [String] -cabalCSrcs c = C.cSources (fst (biModules c)) -cabalCmmSrcs :: Cabal -> [String] -cabalCmmSrcs c = C.cmmSources (fst (biModules c)) -cabalIncludeDirs :: Cabal -> [String] -cabalIncludeDirs c = C.includeDirs (fst (biModules c)) -cabalModules :: Cabal -> [String] -cabalModules c = map display $ snd (biModules c) - -cabalSrcDirs :: Cabal -> [String] -cabalSrcDirs c = C.hsSourceDirs $ fst (biModules c) - -cabalOtherModules :: Cabal -> [String] -cabalOtherModules c = map display $ C.otherModules (fst (biModules c)) ---cabalDepIncludeDirs - -- TODO: Taken from Context, but Context depends on Oracles.Settings, and this -- would then lead to recursive imports. @@ -127,6 +134,16 @@ parseCabal context@Context {..} = do 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 Just C.Configure -> pure Hooks.autoconfUserHooks @@ -134,7 +151,7 @@ parseCabal context@Context {..} = do -- plus a "./Setup test" hook. However, Cabal is also -- "Custom", but doesn't have a configure script. Just C.Custom -> - do configureExists <- liftIO $ doesFileExist (replaceFileName file "configure") + do configureExists <- liftIO $ doesFileExist (replaceFileName (unsafePkgCabalFile package) "configure") if configureExists then pure Hooks.autoconfUserHooks else pure Hooks.simpleUserHooks @@ -146,13 +163,124 @@ parseCabal context@Context {..} = do pure $ Hooks.simpleUserHooks { Hooks.postConf = \_ _ _ _ -> return () } | otherwise -> pure Hooks.simpleUserHooks - bPath <- buildPath context - liftIO $ - withCurrentDirectory (pkgPath package) $ - defaultMainWithHooksNoReadArgs hooks gpd ["configure", "--distdir", bPath, "--ipid", "$pkg-$version"] - hcPath <- builderPath' (Ghc CompileHs stage) - (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb + case pkgCabalFile package of + Nothing -> error "No a cabal package!" + Just f -> do + -- compute the argList. This reuses the GhcCabal Conf builder for now. + -- and will include the flags for this context as well. + flagList <- interpret (target context (CabalFlags stage) [] []) defaultPackageArgs + argList <- interpret (target context (GhcCabal Conf stage) [] []) ghcCabalBuilderArgs + liftIO $ do + putStrLn $ "running main... for " ++ show (pkgPath package) + putStrLn $ show $ argList ++ ["--flags=" ++ unwords flagList ] + 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 + -- build $ target context (GhcCabal Copy stage) [ (pkgPath package) -- + -- , ctxPath -- + -- , ":" -- no strip. ':' special marker + -- , stgPath -- + -- , "" -- + -- , "lib" -- + -- , "share" -- + -- , "v" -- TODO: e.g. "v dyn" for dyn way. + -- ] [] + + -- ghc-cabal logic +-- doCopy directory distDir +-- strip myDestDir myPrefix myLibdir myDocdir withSharedLibs +-- args +-- = withCurrentDirectory directory $ do +-- let copyArgs = ["copy", "--builddir", distDir] +-- ++ (if null myDestDir +-- then [] +-- else ["--destdir", myDestDir]) +-- ++ args +-- copyHooks = userHooks { +-- copyHook = noGhcPrimHook +-- $ modHook False +-- $ copyHook userHooks +-- } + +-- defaultMainWithHooksArgs copyHooks copyArgs +-- where +-- noGhcPrimHook f pd lbi us flags +-- = let pd' +-- | packageName pd == mkPackageName "ghc-prim" = +-- case library pd of +-- Just lib -> +-- let ghcPrim = fromJust (simpleParse "GHC.Prim") +-- ems = filter (ghcPrim /=) (exposedModules lib) +-- lib' = lib { exposedModules = ems } +-- in pd { library = Just lib' } +-- Nothing -> +-- error "Expected a library, but none found" +-- | otherwise = pd +-- in f pd' lbi us flags +-- modHook relocatableBuild f pd lbi us flags +-- = do let verbosity = normal +-- idts = updateInstallDirTemplates relocatableBuild +-- myPrefix myLibdir myDocdir +-- (installDirTemplates lbi) +-- progs = withPrograms lbi +-- stripProgram' = stripProgram { +-- programFindLocation = \_ _ -> return (Just (strip,[])) } + +-- progs' <- configureProgram verbosity stripProgram' progs +-- let lbi' = lbi { +-- withPrograms = progs', +-- installDirTemplates = idts, +-- configFlags = cfg, +-- stripLibs = fromFlag (configStripLibs cfg), +-- withSharedLib = withSharedLibs +-- } + +-- -- This hack allows to interpret the "strip" +-- -- command-line argument being set to ':' to signify +-- -- disabled library stripping +-- cfg | strip == ":" = (configFlags lbi) { configStripLibs = toFlag False } +-- | otherwise = configFlags lbi + +-- f pd lbi' us flags + + Just (Cabal _ _ _ gpd _ _) <- readCabalFile context + + top <- topDirectory + ctxPath <- (top -/-) <$> Context.contextPath context + stgPath <- (top -/-) <$> stagePath context + libPath <- (top -/-) <$> libPath context + + let userHooks = Hooks.autoconfUserHooks + copyHooks = userHooks + hooks = copyHooks + + -- we would need `withCurrentDirectory (pkgPath package)` + liftIO $ defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--destdir", stgPath] + +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 + hooks = regHooks { + Hooks.regHook = \pd lbi us flags -> + let lbi' = lbi { C.installDirTemplates = updateInstallDirTemplates (C.installDirTemplates lbi) } + in (Hooks.regHook regHooks) pd lbi' us flags + } + + liftIO $ defaultMainWithHooksNoReadArgs hooks gpd ["register", "--builddir", ctxPath] + + -- XXX: allow configure to set a prefix with a known variable. $topdir or $pkgroot + -- that would elivate the need for this hack. + where updateInstallDirTemplates :: LBI.InstallDirTemplates -> LBI.InstallDirTemplates + updateInstallDirTemplates idts = idts { LBI.prefix = LBI.toPathTemplate "${pkgroot}/.." } + -- | Parse a ConfiguredCabal file. parseConfiguredCabal :: Context -> Action ConfiguredCabal parseConfiguredCabal context@Context {..} = do From e75834ca58347bc4d5686714d3e184e35a2a8ded Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 11:33:09 +0800 Subject: [PATCH 090/210] Cleanup parse --- src/Hadrian/Haskell/Cabal/Parse.hs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 476d250163..a8c17255af 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -335,16 +335,6 @@ parseConfiguredCabal context@Context {..} = do -- the RTS's library-dirs here. _ -> error "No (or multiple) ghc rts package is registered!!" - wrap = map wrap1 - wrap1 s - | null s = error $ "Wrapping empty value" - | '\'' `elem` s = error $ "Single quote in value to be wrapped:" ++ s - -- We want to be able to assume things like is the - -- start of a value, so check there are no spaces in confusing - -- positions - | head s == ' ' = error "Leading space in value to be wrapped:" ++ s - | last s == ' ' = error "Trailing space in value to be wrapped:" ++ s - | otherwise = ("\'" ++ s ++ "\'") in return $ ConfiguredCabal { dependencies = deps , name = C.unPackageName . C.pkgName . C.package $ pd @@ -380,12 +370,11 @@ parseConfiguredCabal context@Context {..} = do , cmmOpts = C.cmmOptions . fst . biModules $ pd , cppOpts = C.cppOptions . fst . biModules $ pd , ldOpts = C.ldOptions . fst . biModules $ pd - , depIncludeDirs = wrap $ forDeps Installed.includeDirs + , depIncludeDirs = forDeps Installed.includeDirs , depCcOpts = forDeps Installed.ccOptions , depLdOpts = forDeps Installed.ldOptions , buildGhciLib = C.withGHCiLib lbi } - where collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency] collectDeps Nothing = [] From 06c29691e3b0aa05605471d45a4a77a624e96974 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 12:37:29 +0800 Subject: [PATCH 091/210] Adds Types --- hadrian.cabal | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/hadrian.cabal b/hadrian.cabal index 986d4772f3..9758b21727 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -105,6 +105,10 @@ executable hadrian , Types.Context , Types.Package , Types.Stage + , Types.Cabal + , Types.ConfiguredCabal + , Types.Expression + , Types.Way , Target , UserSettings , Utilities From ab6139243c5c3be4965217318019ab3847d94435 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 12:38:11 +0800 Subject: [PATCH 092/210] Proper arguments. --- src/Hadrian/Haskell/Cabal/Parse.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index a8c17255af..b63e0eab24 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -167,10 +167,10 @@ configurePackage context@Context {..} = do case pkgCabalFile package of Nothing -> error "No a cabal package!" Just f -> do - -- compute the argList. This reuses the GhcCabal Conf builder for now. - -- and will include the flags for this context as well. + -- compute the flaglist over the defaultPackageArgs flagList <- interpret (target context (CabalFlags stage) [] []) defaultPackageArgs - argList <- interpret (target context (GhcCabal Conf stage) [] []) ghcCabalBuilderArgs + -- compute the cabal conf args over all the default args + argList <- interpret (target context (GhcCabal Conf stage) [] []) defaultArgs liftIO $ do putStrLn $ "running main... for " ++ show (pkgPath package) putStrLn $ show $ argList ++ ["--flags=" ++ unwords flagList ] From 776ad4937a64f2bc865f419fb95c2688e5d71da9 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 12:38:20 +0800 Subject: [PATCH 093/210] Propper "need" dependency --- src/Hadrian/Haskell/Cabal/Parse.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index b63e0eab24..9c0877d2e6 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -287,10 +287,9 @@ parseConfiguredCabal context@Context {..} = do Just (Cabal _ _ _ gpd pd depPkgs) <- readCabalFile context - -- XXX: need the setup-config here, which would trigger the configure Package - configurePackage context - cPath <- Context.contextPath context + need [cPath -/- "setup-config"] + liftIO $ putStrLn $ "trying to obtain the persitendBuildConfig at " ++ show cPath lbi <- liftIO $ C.getPersistBuildConfig cPath From 40c3424b8b9a4462760cba7acffd3e64064d7489 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 7 Nov 2017 12:38:48 +0800 Subject: [PATCH 094/210] Use configigured cabal data instead of package-data.mk --- src/Expression.hs | 24 ++++++--------- src/Hadrian/Haskell/Cabal.hs | 15 +++++----- src/Oracles/ModuleFiles.hs | 10 +++---- src/Rules/Library.hs | 7 +++-- src/Rules/PackageData.hs | 17 +++-------- src/Rules/Program.hs | 4 +-- src/Rules/Register.hs | 49 +++++++++++++++++++------------ src/Settings.hs | 2 +- src/Settings/Builders/Cc.hs | 4 +-- src/Settings/Builders/Common.hs | 6 ++-- src/Settings/Builders/Ghc.hs | 15 +++++----- src/Settings/Builders/GhcCabal.hs | 9 +++++- src/Settings/Builders/Haddock.hs | 5 ++-- src/Settings/Builders/Hsc2Hs.hs | 11 ++++--- src/Settings/Default.hs | 4 ++- src/Utilities.hs | 10 +++---- 16 files changed, 100 insertions(+), 92 deletions(-) diff --git a/src/Expression.hs b/src/Expression.hs index 1c1ce74201..59713830b1 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -13,8 +13,8 @@ module Expression ( interpret, interpretInContext, -- * Convenient accessors - getBuildRoot, getContext, getPkgData, getPkgDataList, getOutputs, getInputs, - getInput, getOutput, getCabalData, + getBuildRoot, getContext, getOutputs, getInputs, + getInput, getOutput, getConfiguredCabalData, -- * Re-exports module Base, @@ -25,8 +25,9 @@ module Expression ( import qualified Hadrian.Expression as H import Hadrian.Expression hiding (Expr, Predicate, Args) -import Hadrian.Haskell.Cabal.Parse (Cabal) -import Hadrian.Oracles.TextFile (readCabalFile) +import Types.ConfiguredCabal (ConfiguredCabal) +import Hadrian.Oracles.TextFile (readConfiguredCabalFile) + import Types.Expression import Base @@ -35,18 +36,11 @@ import GHC import Context hiding (stage, package, way) 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 =<< getContextPath - --- | 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 =<< getContextPath - -getCabalData :: (Cabal -> a) -> Expr a -getCabalData key = do +-- | Get values from a configured cabal stage. +getConfiguredCabalData :: (ConfiguredCabal -> a) -> Expr a +getConfiguredCabalData key = do ctx <- getContext - Just cabal <- expr (readCabalFile ctx) + Just cabal <- expr (readConfiguredCabalFile 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 e83816c606..1802f10cfd 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -15,32 +15,33 @@ module Hadrian.Haskell.Cabal ( import Stage import Types.Context +import Types.Cabal as C +import Types.ConfiguredCabal as CC import Development.Shake -import Hadrian.Haskell.Cabal.Parse import Hadrian.Package import Hadrian.Oracles.TextFile -- | Read a Cabal file and return the package version. The Cabal file is tracked. pkgVersion :: Context -> Action (Maybe String) -pkgVersion = fmap (fmap version) . readCabalFile +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 :: Context -> Action String pkgIdentifier ctx = do Just cabal <- readCabalFile ctx - return $ if null (version cabal) - then name cabal - else name cabal ++ "-" ++ version cabal + 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 :: Context -> Action (Maybe [PackageName]) -pkgDependencies = fmap (fmap dependencies) . readCabalFile +pkgDependencies = fmap (fmap CC.dependencies) . readConfiguredCabalFile -- | Read a Cabal file and return the package synopsis. The Cabal file is tracked. pkgSynopsis :: Context -> Action (Maybe String) -pkgSynopsis = fmap (fmap synopsis) . readCabalFile +pkgSynopsis = fmap (fmap C.synopsis) . readCabalFile diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index 1284380132..7bf85c9349 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -11,7 +11,7 @@ import Context import GHC import Oracles.PackageData import Expression -import Hadrian.Haskell.Cabal.Parse +import Types.ConfiguredCabal as ConfCabal newtype ModuleFiles = ModuleFiles (Stage, Package) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) @@ -91,7 +91,7 @@ hsSources context = do hsObjects :: Context -> Action [FilePath] hsObjects context = do path <- contextPath context - modules <- interpretInContext context (getCabalData cabalModules) + modules <- interpretInContext context (getConfiguredCabalData ConfCabal.modules) -- GHC.Prim module is only for documentation, we do not actually build it. mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules) @@ -108,7 +108,7 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" contextFiles :: Context -> Action [(String, Maybe FilePath)] contextFiles context@Context {..} = do path <- contextPath context - modules <- fmap sort $ interpretInContext context (getCabalData cabalModules) + 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 @@ -127,8 +127,8 @@ moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package path <- contextPath context - srcDirs <- interpretInContext context (getCabalData cabalSrcDirs) - modules <- fmap sort $ interpretInContext context (getCabalData cabalModules) + 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 diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index e016cd853b..d0c559e5cc 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -3,8 +3,9 @@ module Rules.Library ( ) where import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.Parse as Cabal +import Types.ConfiguredCabal as ConfCabal import qualified System.Directory as IO +import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId) import Base import Context @@ -122,7 +123,7 @@ nonHsObjects :: Context -> Action [FilePath] nonHsObjects context = do path <- contextPath context cObjs <- cObjects context - cmmSrcs <- interpretInContext context (getCabalData cabalCmmSrcs) + cmmSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cmmSrcs) cmmObjs <- mapM (objectPath context) cmmSrcs eObjs <- extraObjects context return $ cObjs ++ cmmObjs ++ eObjs @@ -130,7 +131,7 @@ nonHsObjects context = do cObjects :: Context -> Action [FilePath] cObjects context = do path <- contextPath context - srcs <- interpretInContext context (getCabalData cabalCSrcs) + srcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) objs <- mapM (objectPath context) srcs return $ if way context == threaded then objs diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 4fcd179c20..87af658a30 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -9,6 +9,8 @@ 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 @@ -16,19 +18,8 @@ buildPackageData context@Context {..} = do cabalFile = unsafePkgCabalFile package -- TODO: improve configure = pkgPath package -/- "configure" -- 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 - - need [cabalFile] - build $ target context (GhcCabal Conf stage) [cabalFile] [mk, setupConfig] - postProcessPackageData context mk + dir -/- "setup-config" %> \setupConfig -> do + configurePackage context -- TODO: Get rid of hardcoded file paths. dir -/- "inplace-pkg-config" %> \conf -> do diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index ac67517393..add17e7bde 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.Parse +import Types.ConfiguredCabal as ConfCabal import Base import Context @@ -126,7 +126,7 @@ buildBinary rs bin context@Context {..} = do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ rtsContext { way = w } | w <- ways ] path <- contextPath context - cSrcs <- interpretInContext context (getCabalData cabalCSrcs) + cSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 9ad9469a5a..b78f05a070 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -70,12 +70,14 @@ buildConf rs context@Context {..} conf = do Nothing -> return (pkgName package) depPkgIds <- cabalDependencies context - confIn <- pkgInplaceConfig context + -- confIn <- pkgInplaceConfig 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 [confIn, setupConfig] + need [-- confIn, + setupConfig] need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds @@ -91,23 +93,32 @@ buildConf rs context@Context {..} conf = do ctxPath <- (top -/-) <$> contextPath context stgPath <- (top -/-) <$> stagePath context libPath <- (top -/-) <$> libPath context - build $ target context (GhcCabal Copy stage) [ (pkgPath package) -- - , ctxPath -- - , ":" -- no strip. ':' special marker - , stgPath -- - , "" -- - , "lib" -- - , "share" -- - , "v" -- TODO: e.g. "v dyn" for dyn way. - ] [] - build $ target context (GhcCabal Reg stage) [ -- are provided by the ghcCabalBuilderArgs - libPath - , stgPath - , "" - , libPath - , "share" - , if stage == Stage0 then "NO" else "YES" -- - ] [conf] + + + liftIO $ putStrLn $ ">>> Trying to copy..." + -- COPY logic + copyPackage context + liftIO $ putStrLn $ ">>> Trying to register..." + registerPackage context + -- -- END COPY logic + -- build $ target context (GhcCabal Copy stage) [ (pkgPath package) -- + -- , ctxPath -- + -- , ":" -- no strip. ':' special marker + -- , stgPath -- + -- , "" -- + -- , "lib" -- + -- , "share" -- + -- , "v" -- TODO: e.g. "v dyn" for dyn way. + -- ] [] + -- build $ target context (GhcCabal Reg stage) [ -- are provided by the ghcCabalBuilderArgs + -- libPath + -- , stgPath + -- , "" + -- , libPath + -- , "share" + -- , if stage == Stage0 then "NO" else "YES" -- + -- ] [conf] + buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action () buildStamp rs Context {..} path = do diff --git a/src/Settings.hs b/src/Settings.hs index e40f20d16f..9db70ddceb 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -1,6 +1,6 @@ module Settings ( getArgs, getLibraryWays, getRtsWays, flavour, knownPackages, - findPackageByName, getPkgData, getPkgDataList, isLibrary, stagePackages, + findPackageByName, isLibrary, stagePackages, programContext, integerLibraryName, getDestDir ) where diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index 7cd50b560b..f0022c871b 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -1,13 +1,13 @@ module Settings.Builders.Cc (ccBuilderArgs) where import Settings.Builders.Common -import Hadrian.Haskell.Cabal.Parse (cabalCcArgs) +import Types.ConfiguredCabal as ConfCabal ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay builder Cc ? mconcat - [ getCabalData cabalCcArgs + [ getConfiguredCabalData ConfCabal.ccOpts , getStagedSettingList ConfCcArgs , cIncludeArgs diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index ba0cc614c0..2f573d3a95 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -17,15 +17,15 @@ import Oracles.Setting import Settings import UserSettings -import Hadrian.Haskell.Cabal.Parse (cabalIncludeDirs) +import Types.ConfiguredCabal as ConfCabal cIncludeArgs :: Args cIncludeArgs = do pkg <- getPackage root <- getBuildRoot path <- getBuildPath - incDirs <- getCabalData cabalIncludeDirs - depDirs <- getPkgDataList DepIncludeDirs + incDirs <- getConfiguredCabalData ConfCabal.includeDirs + depDirs <- getConfiguredCabalData ConfCabal.depIncludeDirs cross <- expr crossCompiling compilerOrGhc <- package compiler ||^ package ghc mconcat [ not (cross && compilerOrGhc) ? arg "-Iincludes" diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index e1af08edc0..53ed820164 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -7,7 +7,7 @@ import Hadrian.Haskell.Cabal import Flavour import Rules.Gmp import Settings.Builders.Common -import Hadrian.Haskell.Cabal.Parse (cabalCcArgs) +import Types.ConfiguredCabal as ConfCabal ghcBuilderArgs :: Args ghcBuilderArgs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do @@ -28,7 +28,7 @@ needTouchy = notStage0 ? windowsHost ? do ghcCBuilderArgs :: Args ghcCBuilderArgs = builder (Ghc CompileCWithGhc) ? do way <- getWay - let ccArgs = [ getCabalData cabalCcArgs + let ccArgs = [ getConfiguredCabalData ConfCabal.ccOpts , getStagedSettingList ConfCcArgs , cIncludeArgs , arg "-Werror" @@ -48,7 +48,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do stage <- getStage way <- getWay pkg <- getPackage - libs <- getPkgDataList DepExtraLibs + libs <- pkg == hp2ps ? pure ["m"] intLib <- expr (integerLibrary =<< flavour) gmpLibs <- if stage > Stage0 && intLib == integerGmp then do -- TODO: get this data more gracefully @@ -62,6 +62,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do , nonHsMainPackage pkg ? arg "-no-hs-main" , not (nonHsMainPackage pkg) ? arg "-rtsopts" , pure [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ] + ] splitObjectsArgs :: Args splitObjectsArgs = splitObjects <$> flavour ? do @@ -79,7 +80,7 @@ ghcMBuilderArgs = 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 @@ -104,7 +105,7 @@ commonGhcArgs = do , (pkg == rts) ? notStage0 ? arg ("-ghc-version=" ++ 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 ] @@ -130,7 +131,7 @@ packageGhcArgs = withHsPackage $ \ctx -> do , arg "-no-user-package-db" , bootPackageDatabaseArgs , libraryPackage ? arg ("-this-unit-id " ++ pkgId) - , map ("-package-id " ++) <$> getPkgDataList DepIds ] + , map ("-package-id " ++) <$> getConfiguredCabalData ConfCabal.depIpIds ] includeGhcArgs :: Args includeGhcArgs = do @@ -138,7 +139,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 1461d9de85..7bd53087fe 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -8,6 +8,7 @@ import Context import Flavour import Settings.Builders.Common import qualified Types.Context as Context +import Data.Maybe (fromJust) ghcCabalBuilderArgs :: Args ghcCabalBuilderArgs = mconcat @@ -17,8 +18,14 @@ ghcCabalBuilderArgs = mconcat path <- getContextPath stage <- getStage mconcat [ arg "configure" - , arg =<< pkgPath <$> getPackage + , arg "--cabal-file" + , arg =<< fromJust . pkgCabalFile <$> getPackage + , arg "--distdir" , arg $ top -/- path + , arg "--ipid" + , arg "$pkg-$version" + , arg "--prefix" + , arg "/" , withStaged $ Ghc CompileHs , withStaged (GhcPkg Update) , withBuilderArgs (GhcPkg Update stage) diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index a96299ff31..ded6ff81b7 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -6,6 +6,7 @@ import Hadrian.Haskell.Cabal import Rules.Documentation import Settings.Builders.Common import Settings.Builders.Ghc +import Types.ConfiguredCabal as ConfCabal -- | Given a version string such as "2.16.2" produce an integer equivalent. versionToInt :: String -> Int @@ -34,7 +35,7 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat path <- getBuildPath Just version <- expr $ pkgVersion ctx Just synopsis <- expr $ pkgSynopsis ctx - deps <- getPkgDataList DepNames + deps <- getConfiguredCabalData ConfCabal.depNames haddocks <- expr . haddockDependencies =<< getContext Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs @@ -51,7 +52,7 @@ haddockBuilderArgs = withHsPackage $ \ctx -> 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/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 811375691a..18a63b266a 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -1,6 +1,7 @@ module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where import Settings.Builders.Common +import Types.ConfiguredCabal as ConfCabal hsc2hsBuilderArgs :: Args hsc2hsBuilderArgs = builder Hsc2Hs ? do @@ -40,16 +41,14 @@ getCFlags = do mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) , getStagedSettingList ConfCppArgs , cIncludeArgs - , getPkgDataList CppArgs - , getPkgDataList DepCcArgs + , getConfiguredCabalData ConfCabal.cppOpts + , getConfiguredCabalData ConfCabal.depCcOpts , cWarnings , arg "-include", arg $ autogen -/- "cabal_macros.h" ] getLFlags :: Expr [String] getLFlags = do - extraLibs <- getPkgDataList DepExtraLibs mconcat [ getStagedSettingList ConfGccLinkerArgs , ldArgs - , getPkgDataList LdArgs - , pure [ "-l" ++ unifyPath dir | dir <- extraLibs ] - , getPkgDataList DepLdArgs ] + , getConfiguredCabalData ConfCabal.ldOpts + , getConfiguredCabalData ConfCabal.depLdOpts ] diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 113d313178..83c1172957 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -44,6 +44,8 @@ import Settings.Packages.IntegerGmp import Settings.Packages.Rts import Settings.Packages.RunGhc +import Types.ConfiguredCabal as ConfCabal + -- TODO: Move C source arguments here -- | Default and package-specific source arguments. data SourceArgs = SourceArgs @@ -56,7 +58,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault - , (not <$> builder (Ghc Settings)) ? getPkgDataList HsArgs + , (not <$> builder (Ghc Settings)) ? getConfiguredCabalData ConfCabal.hcOpts , libraryPackage ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] diff --git a/src/Utilities.hs b/src/Utilities.hs index 6d57eb4909..a85fd52580 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -14,6 +14,7 @@ import Oracles.PackageData import Settings import Target import UserSettings +import Types.ConfiguredCabal as ConfCabal build :: Target -> Action () build target = H.build target getArgs @@ -46,7 +47,7 @@ contextDependencies ctx@Context {..} = pkgDependencies ctx >>= \case return . map depContext $ intersectOrd (compare . pkgName) pkgs deps cabalDependencies :: Context -> Action [String] -cabalDependencies ctx = interpretInContext ctx $ getPkgDataList DepIds +cabalDependencies ctx = interpretInContext ctx $ getConfiguredCabalData ConfCabal.depIpIds -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context. stage1Dependencies :: Package -> Action [Package] @@ -61,10 +62,9 @@ libraryTargets includeGhciLib context = do lib0File <- pkgLibraryFile0 context lib0 <- buildDll0 context ghciLib <- pkgGhciLibraryFile context - ghciFlag <- if includeGhciLib - then interpretInContext context $ getPkgData BuildGhciLib - else return "NO" - let ghci = ghciFlag == "YES" + ghci <- if includeGhciLib + then interpretInContext context $ getConfiguredCabalData ConfCabal.buildGhciLib + else return False return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ] -- | Coarse-grain 'need': make sure all given libraries are fully built. From 12a0c566ba5ca525d1f8e6056390ce77680d7f0e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 15:47:13 +0800 Subject: [PATCH 095/210] Use CabalFlags --- src/Settings/Packages/Compiler.hs | 11 ++++++----- src/Settings/Packages/Ghc.hs | 4 ++-- src/Settings/Packages/GhcPrim.hs | 2 +- src/Settings/Packages/Ghci.hs | 2 +- src/Settings/Packages/Haddock.hs | 4 ++-- src/Settings/Packages/Haskeline.hs | 2 +- 6 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/Settings/Packages/Compiler.hs b/src/Settings/Packages/Compiler.hs index bde5618214..5a97e55d6c 100644 --- a/src/Settings/Packages/Compiler.hs +++ b/src/Settings/Packages/Compiler.hs @@ -28,10 +28,6 @@ compilerPackageArgs = package compiler ? do , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP" , (threaded `elem` rtsWays) ? notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS" - , ghcWithNativeCodeGen ? arg "--flags=ncg" - , ghcWithInterpreter ? - notStage0 ? arg "--flags=ghci" - , crossCompiling ? arg "-f-terminfo" , ghcWithInterpreter ? ghcEnableTablesNextToCode ? notM (flag GhcUnregisterised) ? @@ -41,5 +37,10 @@ compilerPackageArgs = package compiler ? do 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) ] diff --git a/src/Settings/Packages/Ghc.hs b/src/Settings/Packages/Ghc.hs index a9e82d2c64..071260ec83 100644 --- a/src/Settings/Packages/Ghc.hs +++ b/src/Settings/Packages/Ghc.hs @@ -9,5 +9,5 @@ ghcPackageArgs = package ghc ? do stage <- getStage path <- expr $ buildPath (vanillaContext stage compiler) mconcat [ builder Ghc ? arg ("-I" ++ path) - , builder (GhcCabal Conf) ? ghcWithInterpreter ? notStage0 ? arg "--flags=ghci" - , builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" ] + , builder CabalFlags ? ghcWithInterpreter ? notStage0 ? arg "ghci" + , builder CabalFlags ? crossCompiling ? arg "-terminfo" ] diff --git a/src/Settings/Packages/GhcPrim.hs b/src/Settings/Packages/GhcPrim.hs index 86d72f5a8e..897e65142d 100644 --- a/src/Settings/Packages/GhcPrim.hs +++ b/src/Settings/Packages/GhcPrim.hs @@ -5,7 +5,7 @@ import Expression ghcPrimPackageArgs :: Args ghcPrimPackageArgs = package ghcPrim ? mconcat - [ builder (GhcCabal Conf) ? arg "--flag=include-ghc-prim" + [ builder CabalFlags ? arg "include-ghc-prim" , builder (Cc CompileC) ? (not <$> flag GccLt44) ? diff --git a/src/Settings/Packages/Ghci.hs b/src/Settings/Packages/Ghci.hs index fa25d2a529..3fcbfb27b1 100644 --- a/src/Settings/Packages/Ghci.hs +++ b/src/Settings/Packages/Ghci.hs @@ -3,4 +3,4 @@ module Settings.Packages.Ghci (ghciPackageArgs) where import Expression ghciPackageArgs :: Args -ghciPackageArgs = package ghci ? notStage0 ? builder (GhcCabal Conf) ? arg "--flags=ghci" +ghciPackageArgs = package ghci ? notStage0 ? builder CabalFlags ? arg "ghci" diff --git a/src/Settings/Packages/Haddock.hs b/src/Settings/Packages/Haddock.hs index 3b2ad9229b..0e57aad32c 100644 --- a/src/Settings/Packages/Haddock.hs +++ b/src/Settings/Packages/Haddock.hs @@ -3,5 +3,5 @@ module Settings.Packages.Haddock (haddockPackageArgs) where import Expression haddockPackageArgs :: Args -haddockPackageArgs = package haddock ? - builder (GhcCabal Conf) ? pure ["--flag", "in-ghc-tree"] +haddockPackageArgs = + package haddock ? builder CabalFlags ? arg ["in-ghc-tree"] diff --git a/src/Settings/Packages/Haskeline.hs b/src/Settings/Packages/Haskeline.hs index ca2a561fe2..629f1f3eab 100644 --- a/src/Settings/Packages/Haskeline.hs +++ b/src/Settings/Packages/Haskeline.hs @@ -5,4 +5,4 @@ import Oracles.Flag (crossCompiling) haskelinePackageArgs :: Args haskelinePackageArgs = - package haskeline ? builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" + package haskeline ? builder CabalFlags ? crossCompiling ? arg "-terminfo" From d732756c4535e2d908fb21a9f42cbd505697d2e7 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 15:47:49 +0800 Subject: [PATCH 096/210] Fix GMP do not depend on the pkgDataFile anymore. --- src/Rules/Gmp.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index 46fad8a32c..6858029d12 100644 --- a/src/Rules/Gmp.hs +++ b/src/Rules/Gmp.hs @@ -78,8 +78,11 @@ gmpRules = do -- This causes integerGmp package to be configured, hence creating the files [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ -> do - dataFile <- pkgDataFile gmpContext - need [dataFile] + -- 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@. From d512b30d2aded9a8671d3b42baf91e2a32fc043e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 15:48:00 +0800 Subject: [PATCH 097/210] Cleanup Generate a bit. --- src/Rules/Generate.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 0d55996daf..3761b6a5e2 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -49,6 +49,9 @@ primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" platformH :: Stage -> FilePath platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" +versionsH :: Stage -> FilePath +versionsH stage = buildDir (vanillaContext stage compiler) -/- "HsVersions.h" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -143,7 +146,9 @@ generatePackageCode context@(Context stage pkg _) = when (pkg == compiler) $ do "//" ++ primopsTxt stage %> \file -> do root <- buildRoot - need $ [root -/- platformH stage, primopsSource] + need $ [ root -/- platformH stage + , root -/- versionsH stage + , primopsSource] ++ fmap (root -/-) includesDependencies build $ target context HsCpp [primopsSource] [file] @@ -152,6 +157,9 @@ generatePackageCode context@(Context stage pkg _) = when (stage == Stage0) $ do "//compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH "//" ++ platformH stage %> go generateGhcBootPlatformH + "//" ++ versionsH stage %> \file -> do + dir <- return "compiler" + copyFile (dir -/- takeFileName file) file when (pkg == rts) $ "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file -> build $ target context GenApply [] [file] From 94d8ab9e5ba7d91a9f56c9bea11ebbcbd5e199fd Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 15:51:49 +0800 Subject: [PATCH 098/210] Provide the cabal configuration with the proper --basedir This requires haskell/cabal/pull/4874 --- src/Settings/Builders/GhcCabal.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 7bd53087fe..654b3ec2fa 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -18,6 +18,8 @@ ghcCabalBuilderArgs = mconcat path <- getContextPath stage <- getStage mconcat [ arg "configure" + , arg "--basedir" + , arg =<< pkgPath <$> getPackage , arg "--cabal-file" , arg =<< fromJust . pkgCabalFile <$> getPackage , arg "--distdir" From c5e465c457e1b6602a781757283d6666aab0f59a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 15:52:34 +0800 Subject: [PATCH 099/210] Cleanup --- src/Hadrian/Haskell/Cabal/Parse.hs | 69 ------------------------------ src/Rules/Register.hs | 30 +------------ 2 files changed, 2 insertions(+), 97 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 9c0877d2e6..3a1e1f945b 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -172,81 +172,12 @@ configurePackage context@Context {..} = do -- compute the cabal conf args over all the default args argList <- interpret (target context (GhcCabal Conf stage) [] []) defaultArgs liftIO $ do - putStrLn $ "running main... for " ++ show (pkgPath package) - putStrLn $ show $ argList ++ ["--flags=" ++ unwords flagList ] 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 - -- build $ target context (GhcCabal Copy stage) [ (pkgPath package) -- - -- , ctxPath -- - -- , ":" -- no strip. ':' special marker - -- , stgPath -- - -- , "" -- - -- , "lib" -- - -- , "share" -- - -- , "v" -- TODO: e.g. "v dyn" for dyn way. - -- ] [] - - -- ghc-cabal logic --- doCopy directory distDir --- strip myDestDir myPrefix myLibdir myDocdir withSharedLibs --- args --- = withCurrentDirectory directory $ do --- let copyArgs = ["copy", "--builddir", distDir] --- ++ (if null myDestDir --- then [] --- else ["--destdir", myDestDir]) --- ++ args --- copyHooks = userHooks { --- copyHook = noGhcPrimHook --- $ modHook False --- $ copyHook userHooks --- } - --- defaultMainWithHooksArgs copyHooks copyArgs --- where --- noGhcPrimHook f pd lbi us flags --- = let pd' --- | packageName pd == mkPackageName "ghc-prim" = --- case library pd of --- Just lib -> --- let ghcPrim = fromJust (simpleParse "GHC.Prim") --- ems = filter (ghcPrim /=) (exposedModules lib) --- lib' = lib { exposedModules = ems } --- in pd { library = Just lib' } --- Nothing -> --- error "Expected a library, but none found" --- | otherwise = pd --- in f pd' lbi us flags --- modHook relocatableBuild f pd lbi us flags --- = do let verbosity = normal --- idts = updateInstallDirTemplates relocatableBuild --- myPrefix myLibdir myDocdir --- (installDirTemplates lbi) --- progs = withPrograms lbi --- stripProgram' = stripProgram { --- programFindLocation = \_ _ -> return (Just (strip,[])) } - --- progs' <- configureProgram verbosity stripProgram' progs --- let lbi' = lbi { --- withPrograms = progs', --- installDirTemplates = idts, --- configFlags = cfg, --- stripLibs = fromFlag (configStripLibs cfg), --- withSharedLib = withSharedLibs --- } - --- -- This hack allows to interpret the "strip" --- -- command-line argument being set to ':' to signify --- -- disabled library stripping --- cfg | strip == ":" = (configFlags lbi) { configStripLibs = toFlag False } --- | otherwise = configFlags lbi - --- f pd lbi' us flags - Just (Cabal _ _ _ gpd _ _) <- readCabalFile context top <- topDirectory diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index b78f05a070..0c26531c25 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -76,14 +76,10 @@ buildConf rs context@Context {..} conf = do -- everything of a package should depend on that -- in the first place. setupConfig <- (contextPath context) <&> (-/- "setup-config") - need [-- confIn, - setupConfig] + need [setupConfig] need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds - -- ghc-cabal copy libraries/terminfo $PWD/_build/stage0/libraries/terminfo : $PWD/_build/stage1 "" "lib" "share" "v" - -- ghc-cabal register libraries/terminfo $PWD/_build/stage0/libraries/terminfo ghc ghc-pkg $PWD/_build/stage1/lib $PWD/_build_stage1 "" "lib" "share" YES - ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- ways ] @@ -94,31 +90,9 @@ buildConf rs context@Context {..} conf = do stgPath <- (top -/-) <$> stagePath context libPath <- (top -/-) <$> libPath context - - liftIO $ putStrLn $ ">>> Trying to copy..." - -- COPY logic + -- copy and register the package copyPackage context - liftIO $ putStrLn $ ">>> Trying to register..." registerPackage context - -- -- END COPY logic - -- build $ target context (GhcCabal Copy stage) [ (pkgPath package) -- - -- , ctxPath -- - -- , ":" -- no strip. ':' special marker - -- , stgPath -- - -- , "" -- - -- , "lib" -- - -- , "share" -- - -- , "v" -- TODO: e.g. "v dyn" for dyn way. - -- ] [] - -- build $ target context (GhcCabal Reg stage) [ -- are provided by the ghcCabalBuilderArgs - -- libPath - -- , stgPath - -- , "" - -- , libPath - -- , "share" - -- , if stage == Stage0 then "NO" else "YES" -- - -- ] [conf] - buildStamp :: [(Resource, Int)] -> Context -> FilePath -> Action () buildStamp rs Context {..} path = do From b38fcd4f009d731d8c2b399da9986537a887a13d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 15:56:32 +0800 Subject: [PATCH 100/210] Drop backets --- src/Settings/Packages/Haddock.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Packages/Haddock.hs b/src/Settings/Packages/Haddock.hs index 0e57aad32c..b1c76b2d26 100644 --- a/src/Settings/Packages/Haddock.hs +++ b/src/Settings/Packages/Haddock.hs @@ -4,4 +4,4 @@ import Expression haddockPackageArgs :: Args haddockPackageArgs = - package haddock ? builder CabalFlags ? arg ["in-ghc-tree"] + package haddock ? builder CabalFlags ? arg "in-ghc-tree" From 5de0279f130b49c4bf8f1830cd4bdd1a8828e6c1 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 22:33:24 +0800 Subject: [PATCH 101/210] Drop stage0PackageDbDir --- src/Base.hs | 9 ++------- src/Context.hs | 4 +--- src/Settings/Builders/Common.hs | 2 +- 3 files changed, 4 insertions(+), 11 deletions(-) diff --git a/src/Base.hs b/src/Base.hs index 945dfe9264..f0b5bbe791 100644 --- a/src/Base.hs +++ b/src/Base.hs @@ -24,7 +24,7 @@ module Base ( hadrianPath, configPath, configFile, sourcePath, shakeFilesDir, generatedDir, generatedPath, inplaceBinPath, inplaceLibBinPath, inplaceLibPath, stageBinPath, stageLibPath, - ghcDeps, templateHscPath, stage0PackageDbDir, + ghcDeps, templateHscPath, inplacePackageDbPath, packageDbPath, packageDbStamp ) where @@ -83,17 +83,12 @@ generatedDir = "generated" generatedPath :: Action FilePath generatedPath = buildRoot <&> (-/- generatedDir) --- | The directory in 'buildRoot' containing the 'Stage0' package database. -stage0PackageDbDir :: FilePath -stage0PackageDbDir = "stage0/lib/package.conf.d" - --- | Path to the inplace package database used in 'Stage1' and later. +-- | Path to the inplace package database. inplacePackageDbPath :: Stage -> FilePath inplacePackageDbPath 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 stage = buildRoot <&> (-/- inplacePackageDbPath stage) -- | We use a stamp file to track the existence of a package database. diff --git a/src/Context.hs b/src/Context.hs index daed19ed0e..20a76c0e62 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -128,9 +128,7 @@ pkgConfFile :: Context -> Action FilePath pkgConfFile context@Context {..} = do root <- buildRoot pid <- pkgId context - let dbDir | stage == Stage0 = root -/- stage0PackageDbDir - | otherwise = root -/- inplacePackageDbPath stage - return $ dbDir -/- pid <.> "conf" + return $ root -/- inplacePackageDbPath 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/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 2f573d3a95..24b62d0ba9 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -58,4 +58,4 @@ bootPackageDatabaseArgs = do top <- expr topDirectory root <- getBuildRoot prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=") - arg $ prefix ++ top -/- root -/- stage0PackageDbDir + arg $ prefix ++ top -/- root -/- inplacePackageDbPath stage From f34c547061c6ba1cd530353dcc3a3c7268e09191 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 22:33:57 +0800 Subject: [PATCH 102/210] Put DerivedConstants.h into rts build dir. --- src/Rules/Generate.hs | 14 ++++++++++---- src/Rules/Register.hs | 7 +++++++ 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 3761b6a5e2..d1c8f984dc 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -157,13 +157,19 @@ generatePackageCode context@(Context stage pkg _) = when (stage == Stage0) $ do "//compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH "//" ++ platformH stage %> go generateGhcBootPlatformH - "//" ++ versionsH stage %> \file -> do - dir <- return "compiler" - copyFile (dir -/- takeFileName file) file + ("//" ++ versionsH stage) <~ return "compiler" - when (pkg == rts) $ "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file -> + when (pkg == rts) $ do + "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file -> build $ target context GenApply [] [file] + -- XXX: this should be fixed properly, e.g. generated here on demand. + ("//" ++ dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir)) + 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 diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 0c26531c25..d9599951eb 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -87,9 +87,16 @@ buildConf rs context@Context {..} conf = do -- see packageRules top <- topDirectory ctxPath <- (top -/-) <$> contextPath context + bldPath <- (top -/-) <$> buildPath context stgPath <- (top -/-) <$> stagePath context libPath <- (top -/-) <$> libPath 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"] + -- copy and register the package copyPackage context registerPackage context From 788214a1eeb6cb60f7f1feffa0a536866725f228 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 8 Nov 2017 22:36:36 +0800 Subject: [PATCH 103/210] Lower stages. I'm still not convinced this is right. We do not have a stage2 now anymore, which feels wrong. Stage0/[bin,lib} - your stage 1 compiler built with the bootstrap compiler. (and so are the libs. Part of the libs is copied from the bootstrap compiler, and still points to the bootstrap compilers location) Stage1/{bin,lib} - your stage 2 compiler, built with the stage1 compielr from `stage0/bin/ghc`, all libs are built with the stage1 compiler from `stage0/bin/ghc`. Freeze stage1 now means, you basically ahve to freeze _build/stage0, because you actually want to build everything in stage1. --- src/Builder.hs | 18 +++++++++--------- src/Rules.hs | 4 ++-- src/Rules/Program.hs | 6 +++--- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 0e1cd2d37f..da4d0e17ab 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -123,18 +123,18 @@ instance NFData Builder -- 'Stage' and GHC 'Package'). builderProvenance :: Builder -> Maybe Context builderProvenance = \case - DeriveConstants -> context Stage1 deriveConstants - GenApply -> context Stage1 genapply - GenPrimopCode -> context Stage1 genprimopcode + DeriveConstants -> context Stage0 deriveConstants + GenApply -> context Stage0 genapply + GenPrimopCode -> context Stage0 genprimopcode Ghc _ Stage0 -> Nothing - Ghc _ stage -> context stage ghc + Ghc _ stage -> context (pred stage) ghc GhcCabal _ _ -> context Stage1 ghcCabal GhcPkg _ Stage0 -> Nothing - GhcPkg _ _ -> context Stage1 ghcPkg - Haddock _ -> context Stage2 haddock - Hpc -> context Stage1 hpcBin - Hsc2Hs stage -> context Stage1 hsc2hs - Unlit -> context Stage1 unlit + GhcPkg _ _ -> context Stage0 ghcPkg + Haddock _ -> context Stage1 haddock + Hpc -> context Stage0 hpcBin + Hsc2Hs stage -> context Stage0 hsc2hs + Unlit -> context Stage0 unlit _ -> Nothing where context s p = Just $ vanillaContext s p diff --git a/src/Rules.hs b/src/Rules.hs index 5d18ddf67a..f1214eed57 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -26,7 +26,7 @@ import Utilities allStages :: [Stage] -allStages = [minBound .. (pred maxBound)] +allStages = [minBound .. maxBound] -- | This rule calls 'need' on all top-level build targets, respecting the -- 'Stage1Only' flag. @@ -72,7 +72,7 @@ packageTargets includeGhciLib stage pkg = do ++ [ haddock | pkg /= rts && docs && stage == Stage1 ] ++ libs ++ more else do -- The only target of a program package is the executable. - prgContext <- programContext (succ stage) pkg + prgContext <- programContext stage pkg prgPath <- programPath prgContext return [prgPath] diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index add17e7bde..dcb5b417e7 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -18,8 +18,8 @@ import Utilities -- | TODO: Drop code duplication buildProgram :: [(Resource, Int)] -> Package -> Rules () buildProgram rs package = do - forM_ [Stage1 ..] $ \stage -> do - let context = vanillaContext (pred stage) package + forM_ [Stage0 ..] $ \stage -> do + let context = vanillaContext stage package -- Rules for programs built in 'buildRoot' "//" ++ stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do @@ -31,7 +31,7 @@ buildProgram rs package = do -- ghc depends on settings, platformConstants, llvm-targets -- ghc-usage.txt, ghci-usage.txt need =<< ghcDeps stage - buildBinary rs bin =<< programContext (pred stage) package + buildBinary rs bin =<< programContext stage package -- Rules for the GHC package, which is built 'inplace' From 2d72f8e91ae1cd566779d9b50523192a38f10d1e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 9 Nov 2017 09:44:50 +0800 Subject: [PATCH 104/210] Less custom logic. --- src/Rules/Generate.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index d1c8f984dc..811d5f0ab9 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -183,12 +183,8 @@ copyRules = do (prefix -/- "ghc-usage.txt") <~ return "driver" (prefix -/- "ghci-usage.txt" ) <~ return "driver" (prefix -/- "llvm-targets") <~ return "." - if stage == Stage0 - then (prefix -/- "platformConstants") <~ askLibDir stage - else (prefix -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir)) - if stage == Stage0 - then (prefix -/- "settings") <~ askLibDir stage - else (prefix -/- "settings") <~ return "." + (prefix -/- "platformConstants") <~ (buildRoot <&> (-/- generatedDir)) + (prefix -/- "settings") <~ return "." (prefix -/- "template-hsc.h") <~ return (pkgPath hsc2hs) where pattern <~ mdir = pattern %> \file -> do From a0d0728581cff5ddc0cb26180a8d069a9cc34e3e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 9 Nov 2017 09:45:14 +0800 Subject: [PATCH 105/210] Adds packageDatabaseArgs --- src/Settings/Builders/Common.hs | 18 ++++++++++++------ src/Settings/Builders/Ghc.hs | 2 +- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 24b62d0ba9..88357a2aaa 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -6,7 +6,7 @@ module Settings.Builders.Common ( module Oracles.Setting, module Settings, module UserSettings, - cIncludeArgs, ldArgs, cArgs, cWarnings, bootPackageDatabaseArgs + cIncludeArgs, ldArgs, cArgs, cWarnings, packageDatabaseArgs, bootPackageDatabaseArgs ) where import Base @@ -49,13 +49,19 @@ cWarnings = do , gccGe46 ? notM windowsHost ? arg "-Werror=unused-but-set-variable" , gccGe46 ? 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 ++ top -/- root -/- inplacePackageDbPath 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 -/- inplacePackageDbPath stage + stage0 ? packageDatabaseArgs diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 53ed820164..72feca9b91 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -129,7 +129,7 @@ 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 " ++) <$> getConfiguredCabalData ConfCabal.depIpIds ] From fe478517f9a61aa5cc3fc3663b08e43761ce508b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 9 Nov 2017 12:29:12 +0800 Subject: [PATCH 106/210] More needs --- src/Rules/Generate.hs | 5 +++++ src/Rules/Register.hs | 9 ++++++++- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 08d870e30c..3a978b330f 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -165,6 +165,11 @@ generatePackageCode context@(Context stage pkg _) = -- XXX: this should be fixed properly, e.g. generated here on demand. ("//" ++ dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir)) + ("//" ++ dir -/- "ghcautoconf.h") <~ (buildRoot <&> (-/- generatedDir)) + ("//" ++ dir -/- "ghcplatform.h") <~ (buildRoot <&> (-/- generatedDir)) + ("//" ++ dir -/- "ghcversion.h") <~ (buildRoot <&> (-/- generatedDir)) + when (pkg == integerGmp) $ do + ("//" ++ dir -/- "ghc-gmp.h") <~ (buildRoot <&> (-/- "include")) where pattern <~ mdir = pattern %> \file -> do dir <- mdir diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index d9599951eb..91e5526c9a 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -95,7 +95,14 @@ buildConf rs context@Context {..} conf = do 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"] + need [ bldPath -/- "DerivedConstants.h" + , bldPath -/- "ghcautoconf.h" + , bldPath -/- "ghcplatform.h" + , bldPath -/- "ghcversion.h" + ] + + when (package == integerGmp) $ + need [bldPath -/- "ghc-gmp.h"] -- copy and register the package copyPackage context From 7b37f157fa6eda081fccfcf63f1fcb844d0dd3b5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 9 Nov 2017 12:35:49 +0800 Subject: [PATCH 107/210] Do not force in-tree-gmp --- src/Settings/Packages/IntegerGmp.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Settings/Packages/IntegerGmp.hs b/src/Settings/Packages/IntegerGmp.hs index 8cc53426ca..0469f291ff 100644 --- a/src/Settings/Packages/IntegerGmp.hs +++ b/src/Settings/Packages/IntegerGmp.hs @@ -18,7 +18,11 @@ integerGmpPackageArgs = package integerGmp ? do mconcat [ builder Cc ? arg includeGmp , builder (GhcCabal Conf) ? mconcat - [ (null gmpIncludeDir && null gmpLibDir) ? - arg "--configure-option=--with-intree-gmp" - , arg ("--configure-option=CFLAGS=" ++ includeGmp) + [ -- (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) ] ] From 0253a7df46934d5220fe5ce23ab73311a2d8a29b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 9 Nov 2017 15:05:54 +0800 Subject: [PATCH 108/210] Drop ghc-cabal --- src/GHC.hs | 2 -- src/GHC/Packages.hs | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 25cd392739..f560df5b35 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -47,7 +47,6 @@ stage0Packages = do , ghc , ghcBoot , ghcBootTh - , ghcCabal , ghci , ghcPkg , ghcTags @@ -77,7 +76,6 @@ stage1Packages = do , directory , filepath , ghc - , ghcCabal , ghcCompact , ghcPrim , haskeline diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 7b8381632e..6a869952c6 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -16,7 +16,7 @@ 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 + , 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 From 15f2c7fc30fe81c89714da14b9e44d56b0476f64 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 9 Nov 2017 15:06:09 +0800 Subject: [PATCH 109/210] Add phony "stage2" target. --- src/Rules.hs | 41 ++++++++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 6115aefd88..8b2da2c452 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -30,19 +30,34 @@ 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 - else do - targets <- concatForM allStages $ \stage -> - concatForM (knownPackages \\ [libffi]) $ - packageTargets False stage - return targets +topLevelTargets = do + phony "stage2" $ do + putNormal "Building stage2" + let libraryPackages = filter isLibrary (knownPackages \\ [libffi]) + need =<< mapM (f Stage1) =<< stagePackages Stage1 + + 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 lirbary /and/ a program. + f :: Stage -> Package -> Action FilePath + f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v")) + | otherwise = programPath =<< programContext stage pkg +-- want [] + -- 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 + -- else do + -- targets <- concatForM allStages $ \stage -> + -- concatForM (knownPackages \\ [libffi]) $ + -- packageTargets False stage + -- return targets -- TODO: Get rid of the @includeGhciLib@ hack. -- | Return the list of targets associated with a given 'Stage' and 'Package'. From 01f5ebd02876be92adb98b7f04d021ae5c3e2215 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 10 Nov 2017 21:53:45 +0800 Subject: [PATCH 110/210] Drop `--basedir`, we use `--cabal-file` now. --- src/Settings/Builders/GhcCabal.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 654b3ec2fa..7bd53087fe 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -18,8 +18,6 @@ ghcCabalBuilderArgs = mconcat path <- getContextPath stage <- getStage mconcat [ arg "configure" - , arg "--basedir" - , arg =<< pkgPath <$> getPackage , arg "--cabal-file" , arg =<< fromJust . pkgCabalFile <$> getPackage , arg "--distdir" From 3a357f732e9f39b9f47003fdba41b59addaca554 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 10 Nov 2017 22:53:45 +0800 Subject: [PATCH 111/210] Adds Data.Bitcode The llvm-ng backend. --- src/GHC.hs | 8 ++++++-- src/GHC/Packages.hs | 7 ++++++- src/Settings/Warnings.hs | 39 ++++++++++++++++++++++++++++++++++++++- 3 files changed, 50 insertions(+), 4 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index f560df5b35..93542df9e8 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -7,8 +7,9 @@ module GHC ( ghcSplit, 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, ghcPackages, isGhcPackage, - defaultPackages, + transformers, unlit, unix, win32, xhtml, dataBitcode, dataBitcodeLlvm, + dataBitcodeEdsl, + ghcPackages, isGhcPackage, defaultPackages, -- * Package information programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, @@ -41,6 +42,9 @@ stage0Packages = do , cabal , compareSizes , compiler + , dataBitcode + , dataBitcodeLlvm + , dataBitcodeEdsl , deriveConstants , genapply , genprimopcode diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 6a869952c6..38829cd605 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -20,7 +20,9 @@ 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 ] + , transformers, unlit, unix, win32, xhtml + , dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl + ] -- TODO: Optimise by switching to sets of packages. isGhcPackage :: Package -> Bool @@ -35,6 +37,9 @@ cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" compiler = hsTop "ghc" `setPath` "compiler" containers = hsLib "containers" +dataBitcode = hsLib "data-bitcode" +dataBitcodeLlvm = hsLib "data-bitcode-llvm" +dataBitcodeEdsl = hsLib "data-bitcode-edsl" deepseq = hsLib "deepseq" deriveConstants = hsUtil "deriveConstants" directory = hsLib "directory" diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index abbc814291..927870cf2d 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -53,4 +53,41 @@ warningArgs = builder Ghc ? do , "-Wno-redundant-constraints" , "-Wno-orphans" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] - , package xhtml ? pure [ "-Wno-unused-imports" ] ] ] + , package xhtml ? pure [ "-Wno-unused-imports" ] ] + , package dataBitcode ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-type-defaults" + ] + , package dataBitcodeLlvm ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-unused-local-binds" + , "-Wno-overlapping-patterns" + , "-Wno-type-defaults" + ] + , package dataBitcodeEdsl ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-type-defaults" + , "-Wno-unused-local-binds" + , "-Wno-overlapping-patterns" + , "-Wno-type-defaults" + , "-Wno-missing-signatures" + ] + ] From da424b3264f7b8086c0fa624958c0bb66e19c5ac Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 11 Nov 2017 10:16:12 +0800 Subject: [PATCH 112/210] Force warnings in the hadrian package to be errors. --- cabal.project | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cabal.project b/cabal.project index 84127017d2..6395fc7da3 100644 --- a/cabal.project +++ b/cabal.project @@ -4,3 +4,6 @@ packages: ../libraries/Cabal/Cabal/ ../libraries/hpc/ ../libraries/parsec/ ./ + +package hadrian + ghc-options: -Werror From 764d008554a275a6c2f4351f805639a5ccb6d944 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 11 Nov 2017 10:16:22 +0800 Subject: [PATCH 113/210] Warning clean up --- src/Builder.hs | 5 ++-- src/Context.hs | 9 +++---- src/Expression.hs | 2 -- src/GHC.hs | 12 --------- src/GHC/Packages.hs | 1 - src/Hadrian/Haskell/Cabal.hs | 1 - src/Hadrian/Haskell/Cabal/Parse.hs | 38 ++++++----------------------- src/Hadrian/Package.hs | 2 -- src/Oracles/ModuleFiles.hs | 7 +----- src/Rules.hs | 22 +++-------------- src/Rules/Compile.hs | 2 +- src/Rules/Generate.hs | 6 ----- src/Rules/Library.hs | 8 +----- src/Rules/PackageData.hs | 29 +--------------------- src/Rules/Program.hs | 1 - src/Rules/Register.hs | 15 +----------- src/Rules/Wrappers.hs | 1 - src/Settings/Builders/GhcCabal.hs | 3 --- src/Settings/Builders/GhcPkg.hs | 4 ++- src/Settings/Default.hs | 1 - src/Settings/Flavours/Quick.hs | 1 - src/Settings/Packages/IntegerGmp.hs | 3 --- src/Utilities.hs | 2 -- src/Way.hs | 6 ----- 24 files changed, 25 insertions(+), 156 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index da4d0e17ab..103ec982bd 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -133,7 +133,7 @@ builderProvenance = \case GhcPkg _ _ -> context Stage0 ghcPkg Haddock _ -> context Stage1 haddock Hpc -> context Stage0 hpcBin - Hsc2Hs stage -> context Stage0 hsc2hs + Hsc2Hs _ -> context Stage0 hsc2hs Unlit -> context Stage0 unlit _ -> Nothing where @@ -166,8 +166,6 @@ instance H.Builder Builder where askBuilderWith :: Builder -> BuildInfo -> Action String askBuilderWith builder BuildInfo {..} = case builder of Ghc Settings _ -> do - let input = fromSingleton msgIn buildInputs - msgIn = "[askBuilder] Exactly one input file expected." needBuilder builder path <- H.builderPath builder need [path] @@ -182,6 +180,7 @@ instance H.Builder Builder where 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 diff --git a/src/Context.hs b/src/Context.hs index 20a76c0e62..4db7f0b1eb 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -13,7 +13,6 @@ module Context ( pkgGhciLibraryFile, pkgConfFile, objectPath, pkgId ) where -import GHC.Generics import Hadrian.Expression import Hadrian.Haskell.Cabal @@ -55,13 +54,13 @@ withHsPackage expr = do pkg <- getPackage ctx <- getContext case pkgCabalFile pkg of - Just file -> expr ctx - Nothing -> mempty + Just _ -> expr ctx + Nothing -> mempty pkgId :: Context -> Action FilePath pkgId context@Context {..} = case pkgCabalFile package of - Just file -> pkgIdentifier context - Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts + Just _ -> pkgIdentifier context + Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts -- | The directroy in 'buildRoot' that will hold the final install artifact for a given 'Context'. libDir :: Context -> FilePath diff --git a/src/Expression.hs b/src/Expression.hs index 59713830b1..6e0598dbae 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -23,7 +23,6 @@ module Expression ( module GHC ) where -import qualified Hadrian.Expression as H import Hadrian.Expression hiding (Expr, Predicate, Args) import Types.ConfiguredCabal (ConfiguredCabal) import Hadrian.Oracles.TextFile (readConfiguredCabalFile) @@ -34,7 +33,6 @@ import Base import Builder import GHC import Context hiding (stage, package, way) -import Oracles.PackageData -- | Get values from a configured cabal stage. getConfiguredCabalData :: (ConfiguredCabal -> a) -> Expr a diff --git a/src/GHC.hs b/src/GHC.hs index 93542df9e8..8e0b039997 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -122,18 +122,6 @@ 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 False - | otherwise = (Just stage ==) <$> installStage package - -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context@Context {..} = do diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 38829cd605..d26565c7c4 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -2,7 +2,6 @@ module GHC.Packages where import Types.Package -import Types.Stage import Hadrian.Package import Hadrian.Utilities diff --git a/src/Hadrian/Haskell/Cabal.hs b/src/Hadrian/Haskell/Cabal.hs index 1802f10cfd..ef95a77490 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -13,7 +13,6 @@ module Hadrian.Haskell.Cabal ( pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis ) where -import Stage import Types.Context import Types.Cabal as C import Types.ConfiguredCabal as CC diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 3a1e1f945b..91b0f98ab0 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -fno-warn-deprecations #-} +-- ^ for now we don't care about cabal deprications. + ----------------------------------------------------------------------------- -- | -- Module : Hadrian.Haskell.Cabal.Parse @@ -16,20 +19,16 @@ module Hadrian.Haskell.Cabal.Parse ( ConfiguredCabal (..) ) where -import Stage import Types.Context import {-# SOURCE #-} Builder hiding (Builder) -- import Hadrian.Builder as H import Data.List.Extra import Development.Shake hiding (doesFileExist) -import Development.Shake.Classes import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C import qualified Distribution.PackageDescription.Parse as C import qualified Distribution.PackageDescription.Configuration as C import qualified Distribution.Text as C -import qualified Distribution.Types.CondTree as C -import qualified Distribution.Types.Dependency as C import qualified Distribution.Types.MungedPackageId as C (mungedName) import qualified Distribution.Verbosity as C import qualified Distribution.Simple.Compiler as C (packageKeySupported, languageToFlags, extensionsToFlags) @@ -44,7 +43,6 @@ import qualified Distribution.Simple.Build as C (initialBuildSteps) import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Distribution.Simple.LocalBuildInfo as LBI -import Distribution.Simple.LocalBuildInfo (LocalBuildInfo) import qualified Distribution.Types.LocalBuildInfo as C import Distribution.Text (display) import Distribution.Simple (defaultMainWithHooksNoReadArgs, compilerFlavor, CompilerFlavor( GHC )) @@ -53,9 +51,8 @@ import Hadrian.Package import Hadrian.Utilities import System.FilePath import System.Directory -import GHC.Generics import qualified Distribution.ModuleName as ModuleName -import Data.Maybe (maybeToList, fromMaybe, fromJust) +import Data.Maybe (maybeToList, fromMaybe ) import GHC.Packages (rts) import Hadrian.Expression import Hadrian.Target @@ -65,11 +62,8 @@ import Types.ConfiguredCabal import Settings import Oracles.Setting -import Hadrian.Haskell.Cabal - import Context.Paths -import Settings.Builders.GhcCabal import Settings.Default import Context @@ -87,21 +81,12 @@ 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.libModules lib) + where libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib) exeBiModules exe = (C.buildInfo exe, ModuleName.main : C.exeModules exe) go [] = error "no buildable component found" go [x] = x go _ = error "can not handle more than one buildinfo yet!" - --- TODO: Taken from Context, but Context depends on Oracles.Settings, and this --- would then lead to recursive imports. -contextPath :: Context -> Action FilePath -contextPath context = buildRoot <&> (-/- contextDir context) - -buildDir :: Context -> FilePath -buildDir context = contextDir context -/- "build" - parseCabal :: Context -> Action Cabal parseCabal context@Context {..} = do let (Just file) = pkgCabalFile package @@ -137,7 +122,7 @@ parseCabal context@Context {..} = do configurePackage :: Context -> Action () configurePackage context@Context {..} = do - Just (Cabal _ _ _ gpd pd depPkgs) <- readCabalFile context + Just (Cabal _ _ _ gpd _pd depPkgs) <- readCabalFile context -- Stage packages are those we have in this stage. stagePkgs <- stagePackages stage @@ -166,7 +151,7 @@ configurePackage context@Context {..} = do case pkgCabalFile package of Nothing -> error "No a cabal package!" - Just f -> do + Just _ -> do -- compute the flaglist over the defaultPackageArgs flagList <- interpret (target context (CabalFlags stage) [] []) defaultPackageArgs -- compute the cabal conf args over all the default args @@ -183,7 +168,6 @@ copyPackage context@Context {..} = do top <- topDirectory ctxPath <- (top -/-) <$> Context.contextPath context stgPath <- (top -/-) <$> stagePath context - libPath <- (top -/-) <$> libPath context let userHooks = Hooks.autoconfUserHooks copyHooks = userHooks @@ -216,7 +200,7 @@ registerPackage context@Context {..} = do parseConfiguredCabal :: Context -> Action ConfiguredCabal parseConfiguredCabal context@Context {..} = do - Just (Cabal _ _ _ gpd pd depPkgs) <- readCabalFile context + Just (Cabal _ _ _ _gpd pd _depPkgs) <- readCabalFile context cPath <- Context.contextPath context need [cPath -/- "setup-config"] @@ -305,9 +289,3 @@ parseConfiguredCabal context@Context {..} = do , depLdOpts = forDeps Installed.ldOptions , buildGhciLib = C.withGHCiLib lbi } - -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 diff --git a/src/Hadrian/Package.hs b/src/Hadrian/Package.hs index 064386ad06..32e741256f 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -24,9 +24,7 @@ module Hadrian.Package ( ) where import Data.Maybe -import Development.Shake.Classes import Development.Shake.FilePath -import GHC.Generics import GHC.Stack import Hadrian.Utilities diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index 7bf85c9349..3b28d166b7 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -9,7 +9,6 @@ import Base import Builder import Context import GHC -import Oracles.PackageData import Expression import Types.ConfiguredCabal as ConfCabal @@ -90,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 <- contextPath context modules <- interpretInContext context (getConfiguredCabalData ConfCabal.modules) - -- GHC.Prim module is only for documentation, we do not actually build it. - mapM (objectPath context . moduleSource) (filter (/= "GHC.Prim") modules) + mapM (objectPath context . moduleSource) modules -- | Generated module files live in the 'Context' specific build directory. generatedFile :: Context -> String -> Action FilePath @@ -107,7 +104,6 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs" -- | Module files for a given 'Context'. contextFiles :: Context -> Action [(String, Maybe FilePath)] contextFiles context@Context {..} = do - path <- contextPath context modules <- fmap sort $ interpretInContext context (getConfiguredCabalData ConfCabal.modules) zip modules <$> askOracle (ModuleFiles (stage, package)) @@ -126,7 +122,6 @@ moduleFilesOracle :: Rules () moduleFilesOracle = void $ do void . addOracle $ \(ModuleFiles (stage, package)) -> do let context = vanillaContext stage package - path <- contextPath context srcDirs <- interpretInContext context (getConfiguredCabalData ConfCabal.srcDirs) modules <- fmap sort $ interpretInContext context (getConfiguredCabalData ConfCabal.modules) autogen <- autogenPath context diff --git a/src/Rules.hs b/src/Rules.hs index 8b2da2c452..e7b2ae6a94 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -20,7 +20,6 @@ import qualified Rules.Program import qualified Rules.Register import Settings import Target -import UserSettings import Utilities @@ -33,7 +32,6 @@ topLevelTargets :: Rules () topLevelTargets = do phony "stage2" $ do putNormal "Building stage2" - let libraryPackages = filter isLibrary (knownPackages \\ [libffi]) need =<< mapM (f Stage1) =<< stagePackages Stage1 where @@ -44,20 +42,6 @@ topLevelTargets = do f :: Stage -> Package -> Action FilePath f stage pkg | isLibrary pkg = pkgConfFile (Context stage pkg (read "v")) | otherwise = programPath =<< programContext stage pkg --- want [] - -- 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 - -- else do - -- targets <- concatForM allStages $ \stage -> - -- concatForM (knownPackages \\ [libffi]) $ - -- packageTargets False stage - -- return targets -- TODO: Get rid of the @includeGhciLib@ hack. -- | Return the list of targets associated with a given 'Stage' and 'Package'. @@ -135,6 +119,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/Compile.hs b/src/Rules/Compile.hs index 67ad1c1539..6bdea523e0 100644 --- a/src/Rules/Compile.hs +++ b/src/Rules/Compile.hs @@ -18,7 +18,7 @@ compilePackage rs context@Context {..} = do need [src] needDependencies context src $ obj <.> "d" buildWithResources rs $ target context (compiler stage) [src] [obj] - compileHs [obj, _hi] = do + compileHs = \[obj, _hi] -> do path <- contextPath context (src, deps) <- lookupDependencies (path -/- ".dependencies") obj need $ src : deps diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 3a978b330f..45e75aa9a5 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -195,12 +195,6 @@ copyRules = do pattern <~ mdir = pattern %> \file -> do dir <- mdir copyFile (dir -/- takeFileName file) file - askLibDir :: Stage -> Action FilePath - askLibDir stage = do - info <- read <$> ask (target (vanillaContext stage ghc) (Ghc Settings stage) [] []) - case lookup "LibDir" info of - Just libdir -> return libdir - Nothing -> error $ "unable to get libdir from ghc" generateRules :: Rules () generateRules = do diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index d0c559e5cc..72e7a731c3 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -12,7 +12,6 @@ import Context import Expression hiding (way, package) import Flavour import Oracles.ModuleFiles -import Oracles.PackageData import Oracles.Setting import Rules.Gmp import Settings @@ -22,9 +21,6 @@ import Utilities archive :: Way -> String -> String archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") -pkgObject :: Way -> String -> String -pkgObject way pkgId = "HS" ++ pkgId ++ (waySuffix way <.> "o") - -- | Building a library consist of building -- the artefacts, and copying it somewhere -- with cabal, and finally registering it @@ -40,7 +36,7 @@ library context@Context{..} = do Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) - "//" ++ libDir context -/- pkgId -/- archive way pkgId %> \a -> do + "//" ++ libDir context -/- pkgId -/- archive way pkgId %> \_ -> do need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId] return () @@ -121,7 +117,6 @@ allObjects context = (++) <$> nonHsObjects context <*> hsObjects context nonHsObjects :: Context -> Action [FilePath] nonHsObjects context = do - path <- contextPath context cObjs <- cObjects context cmmSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cmmSrcs) cmmObjs <- mapM (objectPath context) cmmSrcs @@ -130,7 +125,6 @@ nonHsObjects context = do cObjects :: Context -> Action [FilePath] cObjects context = do - path <- contextPath context srcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) objs <- mapM (objectPath context) srcs return $ if way context == threaded diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 87af658a30..ece155e5bf 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -15,15 +15,12 @@ import Hadrian.Haskell.Cabal.Parse (configurePackage) buildPackageData :: Context -> Rules () buildPackageData context@Context {..} = do let dir = "//" ++ contextDir context - cabalFile = unsafePkgCabalFile package -- TODO: improve - configure = pkgPath package -/- "configure" -- TODO: Get rid of hardcoded file paths. - dir -/- "setup-config" %> \setupConfig -> do + dir -/- "setup-config" %> \_ -> do configurePackage context -- TODO: Get rid of hardcoded file paths. dir -/- "inplace-pkg-config" %> \conf -> do - path <- contextPath context dataFile <- pkgDataFile context need [dataFile] -- ghc-cabal builds inplace package configuration file when (package == rts) $ do @@ -63,7 +60,6 @@ packageCSources pkg | pkg /= rts = getDirectoryFiles (pkgPath pkg) ["*.c"] | otherwise = do windows <- windowsHost - rtsPath <- rtsBuildPath sources <- fmap (map unifyPath) . getDirectoryFiles (pkgPath pkg) . map (-/- "*.c") $ [ ".", "hooks", "sm", "eventlog", "linker" ] ++ [ if windows then "win32" else "posix" ] @@ -88,26 +84,3 @@ packageCmmSources pkg sources <- getDirectoryFiles (pkgPath pkg) ["cbits/*.cmm"] return sources | otherwise = return [] --- 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 --- --- Note: we also inject the cmm and asm sources here, as there is no way to --- specify them with cabal yet. -postProcessPackageData :: Context -> FilePath -> Action () -postProcessPackageData context@Context {..} file = do - top <- topDirectory - cmmSrcs <- packageCmmSources package - asmSrcs <- packageAsmSources package - path <- contextPath context - let len = length (pkgPath package) + length (top -/- path) + 2 - fixFile file $ unlines - . (++ [ "CMM_SRCS = " ++ unwords (map unifyPath cmmSrcs) - , "S_SRCS = " ++ unwords (map unifyPath asmSrcs) ]) - . map (drop len) . filter ('$' `notElem`) . lines diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index dcb5b417e7..c7dd03685d 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -7,7 +7,6 @@ import Base import Context import Expression hiding (stage, way) import Oracles.ModuleFiles -import Oracles.PackageData import Oracles.Setting import Rules.Wrappers import Settings diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 91e5526c9a..9cf6ea7e53 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -57,20 +57,10 @@ copyConf rs context@Context {..} conf = do stdOutToPkgIds :: String -> [String] stdOutToPkgIds = drop 1 . concatMap words . lines -archive :: Way -> String -> String -archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") - -pkgObject :: Way -> String -> String -pkgObject way pkgId = "HS" ++ pkgId ++ (waySuffix way <.> "o") - buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () -buildConf rs context@Context {..} conf = do - pkgId <- case pkgCabalFile package of - Just file -> liftIO $ parseCabalPkgId file - Nothing -> return (pkgName package) +buildConf _ context@Context {..} _conf = do depPkgIds <- cabalDependencies context - -- confIn <- pkgInplaceConfig context -- setup-config, triggers `ghc-cabal configure` -- everything of a package should depend on that @@ -86,10 +76,7 @@ buildConf rs context@Context {..} conf = do -- might need some package-db resource to limit read/write, -- see packageRules top <- topDirectory - ctxPath <- (top -/-) <$> contextPath context bldPath <- (top -/-) <$> buildPath context - stgPath <- (top -/-) <$> stagePath context - libPath <- (top -/-) <$> libPath context -- special package cases (these should ideally be rolled into cabal one way or the other) when (package == rts) $ diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs index 706c065caf..7c497fe52c 100644 --- a/src/Rules/Wrappers.hs +++ b/src/Rules/Wrappers.hs @@ -49,7 +49,6 @@ 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', diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 7bd53087fe..b734ccadb9 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -7,7 +7,6 @@ import Hadrian.Haskell.Cabal import Context import Flavour import Settings.Builders.Common -import qualified Types.Context as Context import Data.Maybe (fromJust) ghcCabalBuilderArgs :: Args @@ -41,14 +40,12 @@ ghcCabalBuilderArgs = mconcat , verbosity < Chatty ? pure [ "-v0", "--configure-option=--quiet" , "--configure-option=--disable-option-checking" ] ] , builder (GhcCabal Copy) ? do - verbosity <- expr getVerbosity mconcat [ arg "copy" , getInputs ] , builder (GhcCabal Reg) ? do top <- expr topDirectory path <- getContextPath - stage <- getStage mconcat [ arg "register" , arg =<< pkgPath <$> getPackage , arg $ top -/- path diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs index 3f8bec07e2..4056d849b5 100644 --- a/src/Settings/Builders/GhcPkg.hs +++ b/src/Settings/Builders/GhcPkg.hs @@ -11,7 +11,9 @@ ghcPkgBuilderArgs = mconcat pkgDb <- expr $ packageDbPath stage mconcat [ arg "--global-package-db" , arg pkgDb - , arg "register" ] + , arg "register" + , verbosity < Chatty ? arg "-v0" + ] , builder (GhcPkg Update) ? do verbosity <- expr getVerbosity context <- getContext diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 9f80f6b555..1ec31da150 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -12,7 +12,6 @@ import CommandLine import Expression import Flavour import Oracles.Flag -import Oracles.PackageData import Settings import Settings.Builders.Alex import Settings.Builders.DeriveConstants diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs index 782305a507..a4f30a1e29 100644 --- a/src/Settings/Flavours/Quick.hs +++ b/src/Settings/Flavours/Quick.hs @@ -2,7 +2,6 @@ module Settings.Flavours.Quick (quickFlavour) where import Expression import Flavour -import Oracles.Flag import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Packages/IntegerGmp.hs b/src/Settings/Packages/IntegerGmp.hs index 0469f291ff..e830411547 100644 --- a/src/Settings/Packages/IntegerGmp.hs +++ b/src/Settings/Packages/IntegerGmp.hs @@ -2,7 +2,6 @@ module Settings.Packages.IntegerGmp (integerGmpPackageArgs) where import Base import Expression -import Oracles.Setting import Rules.Gmp -- TODO: Is this needed? @@ -13,8 +12,6 @@ integerGmpPackageArgs :: Args integerGmpPackageArgs = package integerGmp ? do path <- expr gmpBuildPath let includeGmp = "-I" ++ path -/- "include" - gmpIncludeDir <- getSetting GmpIncludeDir - gmpLibDir <- getSetting GmpLibDir mconcat [ builder Cc ? arg includeGmp , builder (GhcCabal Conf) ? mconcat diff --git a/src/Utilities.hs b/src/Utilities.hs index a85fd52580..894c2e4c41 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -10,10 +10,8 @@ import Hadrian.Utilities import Context import Expression hiding (stage) -import Oracles.PackageData import Settings import Target -import UserSettings import Types.ConfiguredCabal as ConfCabal build :: Target -> Action () diff --git a/src/Way.hs b/src/Way.hs index 6fabb313d9..57dc22fb2f 100644 --- a/src/Way.hs +++ b/src/Way.hs @@ -9,12 +9,6 @@ module Way ( wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf ) where -import Data.IntSet (IntSet) -import qualified Data.IntSet as Set -import Data.List -import Data.Maybe -import Development.Shake.Classes -import Hadrian.Utilities import Types.Way -- | Various combinations of RTS only ways. From 610351a3612c66fbeaab09fd55891fde38b00d19 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 11 Nov 2017 21:07:43 +0800 Subject: [PATCH 114/210] Adds binary-dist support --- src/Builder.hs | 2 +- src/Rules.hs | 19 +++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/src/Builder.hs b/src/Builder.hs index 103ec982bd..7f5ac9dd7e 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -235,7 +235,7 @@ instance H.Builder Builder where Stdout pkgDesc <- cmd [path] ["--expand-pkgroot", "--no-user-package-db", "describe", input ] cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"]) - _ -> cmd echo [path] buildArgs + _ -> cmd echo [path] buildOptions buildArgs -- TODO: Some builders are required only on certain platforms. For example, -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform diff --git a/src/Rules.hs b/src/Rules.hs index e7b2ae6a94..5fc03d8baf 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -22,6 +22,9 @@ import Settings import Target import Utilities +import System.Directory (getCurrentDirectory) + +import Oracles.Setting allStages :: [Stage] allStages = [minBound .. maxBound] @@ -30,6 +33,22 @@ 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 bianries we want to + -- put into the bianry distribution. For now we will just *need* + -- stage2 and package up bin and lib. + need ["stage2"] + version <- setting ProjectVersion + cwd <- liftIO $ getCurrentDirectory + binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" + baseDir <- buildRoot <&> (-/- stageString Stage1) + buildWithCmdOptions [Cwd baseDir] $ + -- ghc is a fake packge here. + target (vanillaContext Stage1 ghc) (Tar Create) + ["bin", "lib"] + [binDistDir -/- "ghc-" ++ version ++ ".tar.xz"] + phony "stage2" $ do putNormal "Building stage2" need =<< mapM (f Stage1) =<< stagePackages Stage1 From 66b1c430d4c07c2c8a0765ceee0c4a14279b1b2a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 13 Nov 2017 10:41:52 +0800 Subject: [PATCH 115/210] Add QuickCrossNG flavour --- hadrian.cabal | 1 + src/Settings.hs | 3 ++- src/Settings/Flavours/QuickCrossNg.hs | 24 ++++++++++++++++++++++++ 3 files changed, 27 insertions(+), 1 deletion(-) create mode 100644 src/Settings/Flavours/QuickCrossNg.hs diff --git a/hadrian.cabal b/hadrian.cabal index 5feee4b3ce..4ffbe57716 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -87,6 +87,7 @@ executable hadrian , Settings.Flavours.Profiled , Settings.Flavours.Quick , Settings.Flavours.QuickCross + , Settings.Flavours.QuickCrossNG , Settings.Flavours.Quickest , Settings.Packages.Base , Settings.Packages.Cabal diff --git a/src/Settings.hs b/src/Settings.hs index 5820431dde..dcb8115313 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -14,6 +14,7 @@ import Settings.Flavours.Profiled import Settings.Flavours.Quick import Settings.Flavours.Quickest import Settings.Flavours.QuickCross +import Settings.Flavours.QuickCrossNG import UserSettings getArgs :: Args @@ -34,7 +35,7 @@ hadrianFlavours :: [Flavour] hadrianFlavours = [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2 , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour - , quickCrossFlavour ] + , quickCrossFlavour, quickCrossNGFlavour ] flavour :: Action Flavour flavour = do diff --git a/src/Settings/Flavours/QuickCrossNg.hs b/src/Settings/Flavours/QuickCrossNg.hs new file mode 100644 index 0000000000..c07e84f62c --- /dev/null +++ b/src/Settings/Flavours/QuickCrossNg.hs @@ -0,0 +1,24 @@ +module Settings.Flavours.QuickCrossNG (quickCrossNGFlavour) where + +import Expression +import Flavour +import Oracles.Flag +import {-# SOURCE #-} Settings.Default + +-- Please update doc/flavours.md when changing this file. +quickCrossNGFlavour :: Flavour +quickCrossNGFlavour = defaultFlavour + { name = "quick-cross-ng" + , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs + , libraryWays = mconcat + [ pure [vanilla] + , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] } + +quickCrossNGArgs :: Args +quickCrossNGArgs = sourceArgs SourceArgs + { hsDefault = pure ["-O0", "-H64m"] + , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvmng" ] + , hsCompiler = stage0 ? arg "-O" + , hsGhc = mconcat + [ stage0 ? arg "-O" + , stage1 ? mconcat [ arg "-O0", arg "-fllvmng" ] ] } From b9200779fb2f83057501e7227d2b96b9fa91127c Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 13 Nov 2017 10:47:47 +0800 Subject: [PATCH 116/210] Adds head.hackage repository. --- cabal.project | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/cabal.project b/cabal.project index 6395fc7da3..67db36f54c 100644 --- a/cabal.project +++ b/cabal.project @@ -7,3 +7,11 @@ packages: ../libraries/Cabal/Cabal/ package hadrian ghc-options: -Werror + +repository head.hackage + url: http://head.hackage.haskell.org/ + secure: True + root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740 + 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb + 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e + key-threshold: 3 \ No newline at end of file From 3387b7fc66e8bc1f48bf2e15968b0528c6b9ff4e Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 13 Nov 2017 15:07:39 +0800 Subject: [PATCH 117/210] Better SemiMonoProp guards --- .gitmodules | 6 ++++++ happy | 1 + shake | 1 + src/Context.hs | 5 +++++ src/Hadrian/Expression.hs | 9 +++++++-- 5 files changed, 20 insertions(+), 2 deletions(-) create mode 100644 .gitmodules create mode 160000 happy create mode 160000 shake diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000000..76693089f2 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,6 @@ +[submodule "shake"] + path = shake + url = https://github.com/ndmitchell/shake.git +[submodule "happy"] + path = happy + url = https://github.com/simonmar/happy.git diff --git a/happy b/happy new file mode 160000 index 0000000000..f4bb3d6edf --- /dev/null +++ b/happy @@ -0,0 +1 @@ +Subproject commit f4bb3d6edfbb558f10b7be028f7f9f4d3109cb53 diff --git a/shake b/shake new file mode 160000 index 0000000000..1d8e816d7e --- /dev/null +++ b/shake @@ -0,0 +1 @@ +Subproject commit 1d8e816d7ebe531ae7d307198f1b3f88150a7040 diff --git a/src/Context.hs b/src/Context.hs index 4db7f0b1eb..2ab6f48066 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Context ( -- * Context Context (..), vanillaContext, stageContext, @@ -49,7 +50,11 @@ getStagedSettingList f = getSettingList . f =<< getStage -- | Construct an expression that depends on the current package having -- a Cabal file. For non haskell contexts it's empty. +#if !(MIN_VERSION_base(4,11,0)) withHsPackage :: (Monoid a, Semigroup a) => (Context -> Expr Context b a) -> Expr Context b a +#else +withHsPackage :: Monoid a => (Context -> Expr Context b a) -> Expr Context b a +#endif withHsPackage expr = do pkg <- getPackage ctx <- getContext diff --git a/src/Hadrian/Expression.hs b/src/Hadrian/Expression.hs index e5c01f8935..7305ad908c 100644 --- a/src/Hadrian/Expression.hs +++ b/src/Hadrian/Expression.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, CPP #-} module Hadrian.Expression ( -- * Expressions Expr, Predicate, Args, @@ -19,7 +19,7 @@ module Hadrian.Expression ( import Control.Monad.Extra import Control.Monad.Trans import Control.Monad.Trans.Reader -import Data.Semigroup +import Data.Semigroup (Semigroup, (<>)) import Development.Shake import Development.Shake.Classes @@ -71,7 +71,12 @@ class ToPredicate p c b where infixr 3 ? -- | Apply a predicate to an expression. + +#if !(MIN_VERSION_base(4,11,0)) (?) :: (Monoid a, Semigroup a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a +#else +(?) :: (Monoid a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a +#endif p ? e = do bool <- toPredicate p if bool then e else mempty From 681128e86ab9b53dab32786f1ae1d46a769b56b5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 14 Nov 2017 09:40:33 +0800 Subject: [PATCH 118/210] No more GhcCabal --- hadrian.cabal | 1 - src/Settings/Default.hs | 2 -- src/Settings/Packages/GhcCabal.hs | 31 ------------------------------- 3 files changed, 34 deletions(-) delete mode 100644 src/Settings/Packages/GhcCabal.hs diff --git a/hadrian.cabal b/hadrian.cabal index 4ffbe57716..8d87e5a71c 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -93,7 +93,6 @@ executable hadrian , Settings.Packages.Cabal , Settings.Packages.Compiler , Settings.Packages.Ghc - , Settings.Packages.GhcCabal , Settings.Packages.Ghci , Settings.Packages.GhcPkg , Settings.Packages.GhcPrim diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 1ec31da150..03ebb6f9f1 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -32,7 +32,6 @@ 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 @@ -163,7 +162,6 @@ defaultPackageArgs = mconcat [ basePackageArgs , cabalPackageArgs , compilerPackageArgs - , ghcCabalPackageArgs , ghciPackageArgs , ghcPackageArgs , ghcPkgPackageArgs diff --git a/src/Settings/Packages/GhcCabal.hs b/src/Settings/Packages/GhcCabal.hs deleted file mode 100644 index 0e915b3ea6..0000000000 --- a/src/Settings/Packages/GhcCabal.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Settings.Packages.GhcCabal (ghcCabalPackageArgs) where - -import Hadrian.Haskell.Cabal - -import Base -import Expression -import Utilities - -ghcCabalPackageArgs :: Args -ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do - cabalDeps <- expr $ stage1Dependencies cabal - cabalVersion <- expr $ pkgVersion (unsafePkgCabalFile cabal) -- TODO: improve - mconcat - [ pure [ "-package " ++ pkgName pkg | pkg <- cabalDeps \\ [parsec, mtl] ] - , arg "--make" - , arg "-j" - , pure ["-Wall", "-fno-warn-unused-imports", "-fno-warn-warnings-deprecations"] - , arg ("-DCABAL_VERSION=" ++ replace "." "," cabalVersion) - , arg "-DCABAL_PARSEC" - , arg "-DBOOTSTRAPPING" - , arg "-DMIN_VERSION_binary_0_8_0" - , arg "libraries/text/cbits/cbits.c" - , arg "-ilibraries/Cabal/Cabal" - , arg "-ilibraries/binary/src" - , arg "-ilibraries/filepath" - , arg "-ilibraries/hpc" - , arg "-ilibraries/mtl" - , arg "-ilibraries/text" - , arg "-Ilibraries/text/include" - , arg "-ilibraries/parsec" ] - From d5a7983442a3714ffd013514e80bf8762d7b0acd Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 14 Nov 2017 11:27:48 +0800 Subject: [PATCH 119/210] Do not hack the rts on an empty package database --- src/Hadrian/Haskell/Cabal/Parse.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 91b0f98ab0..b357d9d416 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -235,6 +235,8 @@ parseConfiguredCabal context@Context {..} = do -- 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])] -> From 8ebbd32b9e638adb25ddb77939c3830c81ac0ca2 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 14 Nov 2017 11:28:20 +0800 Subject: [PATCH 120/210] Do not inject "Main" as a module, when `main-is:` is not a Haskell file. --- src/Hadrian/Haskell/Cabal/Parse.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index b357d9d416..c8fe8e242f 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -82,10 +82,18 @@ biModules pd = go [ comp | comp@(bi,_) <- (map libBiModules . maybeToList $ C.li ++ (map exeBiModules $ C.executables pd) , C.buildable bi ] where libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib) - exeBiModules exe = (C.buildInfo exe, ModuleName.main : C.exeModules exe) + 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 From 7d5bfaca62913576db57f6a0bfd4fa7517c3c6ef Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 14 Nov 2017 11:28:31 +0800 Subject: [PATCH 121/210] Unlit now has it's own cabal file. --- src/GHC.hs | 1 - src/GHC/Packages.hs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 8e0b039997..4b509869b3 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -134,7 +134,6 @@ programPath context@Context {..} = do nonCabalContext :: Context -> Bool nonCabalContext Context {..} = (package `elem` [ hp2ps , touchy - , unlit ]) || package == ghcCabal && stage == Stage0 diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index d26565c7c4..52d151544d 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -80,7 +80,7 @@ text = hsLib "text" time = hsLib "time" touchy = cUtil "touchy" transformers = hsLib "transformers" -unlit = cUtil "unlit" +unlit = hsUtil "unlit" unix = hsLib "unix" win32 = hsLib "Win32" xhtml = hsLib "xhtml" From 6633cb7bfa403776c3d79784f2070d80ca74734c Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 14 Nov 2017 14:20:25 +0800 Subject: [PATCH 122/210] No more cUtil! --- src/GHC/Packages.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 52d151544d..0c3f5c4161 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -58,7 +58,7 @@ ghcSplit = hsUtil "ghc-split" haddock = hsUtil "haddock" haskeline = hsLib "haskeline" hsc2hs = hsUtil "hsc2hs" -hp2ps = cUtil "hp2ps" +hp2ps = hsUtil "hp2ps" hpc = hsLib "hpc" hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" integerGmp = hsLib "integer-gmp" @@ -78,7 +78,7 @@ templateHaskell = hsLib "template-haskell" terminfo = hsLib "terminfo" text = hsLib "text" time = hsLib "time" -touchy = cUtil "touchy" +touchy = hsUtil "touchy" transformers = hsLib "transformers" unlit = hsUtil "unlit" unix = hsLib "unix" @@ -105,10 +105,6 @@ hsPrg name = hsProgram name name 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 } From c14cf2cc9953b39803d9db21c6d4832255463583 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 14 Nov 2017 17:41:52 +0800 Subject: [PATCH 123/210] Adds Hsc2Hs package flags. Use the `in-ghc-tree` flag to build a relocatable hsc2hs in the ghc/bin folder. --- hadrian.cabal | 1 + src/Rules/Program.hs | 1 - src/Settings/Default.hs | 2 ++ src/Settings/Packages/Hsc2Hs.hs | 7 +++++++ 4 files changed, 10 insertions(+), 1 deletion(-) create mode 100644 src/Settings/Packages/Hsc2Hs.hs diff --git a/hadrian.cabal b/hadrian.cabal index 8d87e5a71c..fdd969746d 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -97,6 +97,7 @@ executable hadrian , Settings.Packages.GhcPkg , Settings.Packages.GhcPrim , Settings.Packages.Haddock + , Settings.Packages.Hsc2Hs , Settings.Packages.Haskeline , Settings.Packages.IntegerGmp , Settings.Packages.Rts diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index c7dd03685d..437cb86826 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -129,7 +129,6 @@ buildBinary rs bin context@Context {..} = do cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs - ++ [ path -/- "build" -/- "Paths_hsc2hs.o" | package == hsc2hs ] ++ [ path -/- "build" -/- "Paths_haddock.o" | package == haddock ] need binDeps buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin] diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 03ebb6f9f1..b5673e8592 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -36,6 +36,7 @@ import Settings.Packages.Ghci import Settings.Packages.GhcPkg import Settings.Packages.GhcPrim import Settings.Packages.Haddock +import Settings.Packages.Hsc2Hs import Settings.Packages.Haskeline import Settings.Packages.IntegerGmp import Settings.Packages.Rts @@ -167,6 +168,7 @@ defaultPackageArgs = mconcat , ghcPkgPackageArgs , ghcPrimPackageArgs , haddockPackageArgs + , hsc2hsPackageArgs , haskelinePackageArgs , integerGmpPackageArgs , rtsPackageArgs diff --git a/src/Settings/Packages/Hsc2Hs.hs b/src/Settings/Packages/Hsc2Hs.hs new file mode 100644 index 0000000000..e5aa8bbc96 --- /dev/null +++ b/src/Settings/Packages/Hsc2Hs.hs @@ -0,0 +1,7 @@ +module Settings.Packages.Hsc2Hs (hsc2hsPackageArgs) where + +import Expression + +hsc2hsPackageArgs :: Args +hsc2hsPackageArgs = + package hsc2hs ? builder CabalFlags ? arg "in-ghc-tree" From e2ab4086e9da57113d7e4c6e671c275a68679337 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 15 Nov 2017 15:07:12 +0800 Subject: [PATCH 124/210] Drop install directory hack With haskell/cabal/#4892 this should not be necessary anymore. --- src/Hadrian/Haskell/Cabal/Parse.hs | 15 ++------------- src/Settings/Builders/GhcCabal.hs | 2 +- 2 files changed, 3 insertions(+), 14 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index c8fe8e242f..cc21a01e88 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -42,7 +42,6 @@ import qualified Distribution.Simple.Configure as C (getPersistBuildConf import qualified Distribution.Simple.Build as C (initialBuildSteps) import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.Simple.PackageIndex as PackageIndex -import qualified Distribution.Simple.LocalBuildInfo as LBI import qualified Distribution.Types.LocalBuildInfo as C import Distribution.Text (display) import Distribution.Simple (defaultMainWithHooksNoReadArgs, compilerFlavor, CompilerFlavor( GHC )) @@ -191,18 +190,8 @@ registerPackage context@Context {..} = do Just (Cabal _ _ _ gpd _ _) <- readCabalFile context let userHooks = Hooks.autoconfUserHooks regHooks = userHooks - hooks = regHooks { - Hooks.regHook = \pd lbi us flags -> - let lbi' = lbi { C.installDirTemplates = updateInstallDirTemplates (C.installDirTemplates lbi) } - in (Hooks.regHook regHooks) pd lbi' us flags - } - - liftIO $ defaultMainWithHooksNoReadArgs hooks gpd ["register", "--builddir", ctxPath] - - -- XXX: allow configure to set a prefix with a known variable. $topdir or $pkgroot - -- that would elivate the need for this hack. - where updateInstallDirTemplates :: LBI.InstallDirTemplates -> LBI.InstallDirTemplates - updateInstallDirTemplates idts = idts { LBI.prefix = LBI.toPathTemplate "${pkgroot}/.." } + + liftIO $ defaultMainWithHooksNoReadArgs regHooks gpd ["register", "--builddir", ctxPath] -- | Parse a ConfiguredCabal file. parseConfiguredCabal :: Context -> Action ConfiguredCabal diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index b734ccadb9..6c2de686c6 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -24,7 +24,7 @@ ghcCabalBuilderArgs = mconcat , arg "--ipid" , arg "$pkg-$version" , arg "--prefix" - , arg "/" + , arg "${pkgroot}/.." , withStaged $ Ghc CompileHs , withStaged (GhcPkg Update) , withBuilderArgs (GhcPkg Update stage) From 5907f14729bd28b1770789d2c7eb9d664ff10747 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 15 Nov 2017 16:47:58 +0800 Subject: [PATCH 125/210] Make --build-root a configure flag. This resulted in quite a messy untangling of recursive module imports :( --- build.cabal.sh | 0 hadrian.cabal | 2 +- src/Builder.hs-boot | 4 +++- src/CommandLine.hs | 28 ++++++++++++++++++++---- src/Expression.hs | 4 +--- src/GHC.hs | 7 +----- src/Hadrian/Haskell/Cabal/Parse.hs | 1 - src/Hadrian/Utilities.hs | 2 +- src/Main.hs | 4 ++-- src/Rules.hs | 2 ++ src/Rules/Documentation.hs | 2 +- src/Rules/Generate.hs | 4 +++- src/Rules/Libffi.hs | 1 + src/Rules/Library.hs | 3 ++- src/Rules/PackageData.hs | 2 ++ src/Rules/Program.hs | 2 ++ src/Rules/Test.hs | 3 ++- src/Rules/Wrappers.hs | 2 ++ src/Settings.hs | 3 ++- src/Settings/Builders/Alex.hs | 1 + src/Settings/Builders/Cc.hs | 1 + src/Settings/Builders/Common.hs | 1 + src/Settings/Builders/DeriveConstants.hs | 1 + src/Settings/Builders/Ghc.hs | 4 +++- src/Settings/Builders/GhcCabal.hs | 5 ++++- src/Settings/Builders/GhcPkg.hs | 1 + src/Settings/Builders/Happy.hs | 1 + src/Settings/Builders/HsCpp.hs | 2 ++ src/Settings/Builders/Hsc2Hs.hs | 3 +++ src/Settings/Builders/Ld.hs | 1 + src/Settings/Builders/Xelatex.hs | 2 ++ src/Settings/Default.hs | 6 ++++- src/Settings/Default.hs-boot | 4 ++-- src/Settings/Flavours/Development.hs | 2 +- src/Settings/Flavours/Performance.hs | 2 +- src/Settings/Flavours/Profiled.hs | 2 +- src/Settings/Flavours/Quick.hs | 2 +- src/Settings/Flavours/QuickCross.hs | 2 +- src/Settings/Flavours/QuickCrossNg.hs | 2 +- src/Settings/Flavours/Quickest.hs | 2 +- src/Settings/Packages/Base.hs | 1 + src/Settings/Packages/Cabal.hs | 1 + src/Settings/Packages/Compiler.hs | 3 ++- src/Settings/Packages/Ghc.hs | 1 + src/Settings/Packages/GhcPkg.hs | 1 + src/Settings/Packages/GhcPrim.hs | 1 + src/Settings/Packages/Ghci.hs | 1 + src/Settings/Packages/Haddock.hs | 1 + src/Settings/Packages/Haskeline.hs | 1 + src/Settings/Packages/Hsc2Hs.hs | 1 + src/Settings/Packages/IntegerGmp.hs | 1 + src/Settings/Packages/Rts.hs | 1 + src/Settings/Packages/RunGhc.hs | 1 + src/Settings/Warnings.hs | 1 + src/{ => Types}/Flavour.hs | 7 ++++-- src/UserSettings.hs | 3 ++- src/Utilities.hs | 7 ++++++ 57 files changed, 116 insertions(+), 40 deletions(-) mode change 100644 => 100755 build.cabal.sh rename src/{ => Types}/Flavour.hs (90%) diff --git a/build.cabal.sh b/build.cabal.sh old mode 100644 new mode 100755 diff --git a/hadrian.cabal b/hadrian.cabal index fdd969746d..07bbbc1a9f 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -25,7 +25,6 @@ executable hadrian , Context.Paths , Environment , Expression - , Flavour , GHC , GHC.Packages , Hadrian.Builder @@ -110,6 +109,7 @@ executable hadrian , Types.Cabal , Types.ConfiguredCabal , Types.Expression + , Types.Flavour , Types.Way , Target , UserSettings diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index fc862478f7..074248d272 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -39,4 +39,6 @@ data Builder = Alex | Xelatex | CabalFlags Stage -builderPath' :: Builder -> Action FilePath \ No newline at end of file +instance Eq Builder + +builderPath' :: Builder -> Action FilePath diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 2344dcc99c..3c66fa1ea1 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 + cmdInstallDestDir, lookupBuildRoot ) 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 @@ -21,7 +22,9 @@ data CommandLineArgs = CommandLineArgs , integerSimple :: Bool , progressColour :: UseColour , progressInfo :: ProgressInfo - , splitObjects :: Bool } + , splitObjects :: Bool + , buildRoot :: BuildRoot + } deriving (Eq, Show) -- | Default values for 'CommandLineArgs'. @@ -34,7 +37,9 @@ defaultCommandLineArgs = CommandLineArgs , integerSimple = False , progressColour = Auto , progressInfo = Brief - , splitObjects = False } + , splitObjects = False + , buildRoot = UserSettings.userBuildRoot + } readConfigure :: Either String (CommandLineArgs -> CommandLineArgs) readConfigure = Right $ \flags -> flags { configure = True } @@ -42,6 +47,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 } @@ -84,6 +98,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 [] ["build-root"] (OptArg readBuildRoot "BUILD_ROOT") + "Build root (Default _build)." , Option [] ["flavour"] (OptArg readFlavour "FLAVOUR") "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)." , Option [] ["freeze1"] (NoArg readFreeze1) @@ -107,6 +123,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 args Map.empty cmdLineArgs :: Action CommandLineArgs @@ -118,6 +135,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/Expression.hs b/src/Expression.hs index 6e0598dbae..64d2d5c194 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -20,7 +20,6 @@ module Expression ( module Base, module Builder, module Context, - module GHC ) where import Hadrian.Expression hiding (Expr, Predicate, Args) @@ -30,8 +29,7 @@ import Hadrian.Oracles.TextFile (readConfiguredCabalFile) import Types.Expression import Base -import Builder -import GHC +import {-# SOURCE #-} Builder import Context hiding (stage, package, way) -- | Get values from a configured cabal stage. diff --git a/src/GHC.hs b/src/GHC.hs index 4b509869b3..883b3dbc48 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -15,7 +15,7 @@ module GHC ( programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage, -- * Miscellaneous - programPath, ghcSplitPath, stripCmdPath, buildDll0 + programPath, ghcSplitPath, stripCmdPath ) where import Base @@ -169,8 +169,3 @@ stripCmdPath = do "arm-unknown-linux" -> return ":" -- HACK: from the make-based system, see the ref above _ -> return "strip" - -buildDll0 :: Context -> Action Bool -buildDll0 Context {..} = do - windows <- windowsHost - return $ windows && stage == Stage1 && package == compiler diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index cc21a01e88..f42b1cb1be 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -202,7 +202,6 @@ parseConfiguredCabal context@Context {..} = do cPath <- Context.contextPath context need [cPath -/- "setup-config"] - liftIO $ putStrLn $ "trying to obtain the persitendBuildConfig at " ++ show cPath lbi <- liftIO $ C.getPersistBuildConfig cPath -- XXX: move this into it's own rule for build/autogen/cabal_macros.h, and build/autogen/Path_*.hs diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index fb751fee53..186d1b95d0 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -166,7 +166,7 @@ userSetting defaultValue = do extra <- shakeExtra <$> getShakeOptions return $ lookupExtra defaultValue extra -newtype BuildRoot = BuildRoot FilePath deriving Typeable +newtype BuildRoot = BuildRoot FilePath deriving (Show, Eq, Typeable) -- | All build results are put into the 'buildRoot' directory. buildRoot :: Action FilePath diff --git a/src/Main.hs b/src/Main.hs index 926b4d819c..4713252f88 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -15,6 +15,7 @@ import qualified Rules.Selftest import qualified Rules.Test import qualified UserSettings + main :: IO () main = do -- Provide access to command line arguments and some user settings through @@ -22,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 ] diff --git a/src/Rules.hs b/src/Rules.hs index 5fc03d8baf..7a59060e77 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -21,6 +21,8 @@ import qualified Rules.Register import Settings import Target import Utilities +import GHC.Packages +import GHC import System.Directory (getCurrentDirectory) diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 5a5698c995..f9882319ed 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -8,7 +8,7 @@ module Rules.Documentation ( import Base import Context -import Flavour +import Types.Flavour import GHC import Oracles.ModuleFiles import Oracles.PackageData diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 45e75aa9a5..205d43bcf2 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -5,7 +5,7 @@ module Rules.Generate ( import Base import Expression -import Flavour +import Types.Flavour import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting @@ -15,6 +15,8 @@ import Target import Settings import Settings.Packages.Rts import Utilities +import GHC.Packages +import GHC -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index 0ad119b923..4edc0e8343 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -6,6 +6,7 @@ import Settings.Builders.Common import Settings.Packages.Rts import Target import Utilities +import GHC.Packages -- | Libffi is considered a Stage1 package. This determines its build directory. libffiContext :: Context diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 72e7a731c3..1c5c2766ea 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -10,13 +10,14 @@ import Hadrian.Haskell.Cabal.Parse (parseCabalPkgId) import Base import Context import Expression hiding (way, package) -import Flavour +import Types.Flavour import Oracles.ModuleFiles import Oracles.Setting import Rules.Gmp import Settings import Target import Utilities +import GHC.Packages archive :: Way -> String -> String archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index ece155e5bf..9c5771eba6 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -8,6 +8,8 @@ import Rules.Generate import Settings.Packages.Rts import Target import Utilities +import GHC.Packages +import GHC import Hadrian.Haskell.Cabal.Parse (configurePackage) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 437cb86826..c7220f93b1 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -13,6 +13,8 @@ import Settings import Settings.Packages.Rts import Target import Utilities +import GHC.Packages +import GHC -- | TODO: Drop code duplication buildProgram :: [(Resource, Int)] -> Package -> Rules () diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index a650ca0850..f9f89d0b20 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -2,12 +2,13 @@ module Rules.Test (testRules) where import Base import Expression -import Flavour +import Types.Flavour import Oracles.Flag import Oracles.Setting import Settings import Target import Utilities +import GHC.Packages -- TODO: clean up after testing testRules :: Rules () diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs index 7c497fe52c..f1dfb7d4dd 100644 --- a/src/Rules/Wrappers.hs +++ b/src/Rules/Wrappers.hs @@ -8,6 +8,8 @@ import Base import Expression import Oracles.Setting import Settings +import GHC.Packages +import GHC (installStage) -- | Wrapper is an expression depending on (i) the 'FilePath' to the library and -- (ii) the name of the wrapped binary. diff --git a/src/Settings.hs b/src/Settings.hs index dcb8115313..83e8071331 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -6,7 +6,7 @@ module Settings ( import CommandLine import Expression -import Flavour +import Types.Flavour import {-# SOURCE #-} Settings.Default import Settings.Flavours.Development import Settings.Flavours.Performance @@ -16,6 +16,7 @@ import Settings.Flavours.Quickest import Settings.Flavours.QuickCross import Settings.Flavours.QuickCrossNG import UserSettings +import GHC.Packages getArgs :: Args getArgs = expr flavour >>= args diff --git a/src/Settings/Builders/Alex.hs b/src/Settings/Builders/Alex.hs index e0ef1367f7..99ef898f9b 100644 --- a/src/Settings/Builders/Alex.hs +++ b/src/Settings/Builders/Alex.hs @@ -1,6 +1,7 @@ module Settings.Builders.Alex (alexBuilderArgs) where import Settings.Builders.Common +import Builder () alexBuilderArgs :: Args alexBuilderArgs = builder Alex ? mconcat [ arg "-g" diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index 58a09b96b6..eeffec6b13 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -2,6 +2,7 @@ module Settings.Builders.Cc (ccBuilderArgs) where import Settings.Builders.Common import Types.ConfiguredCabal as ConfCabal +import Builder () ccBuilderArgs :: Args ccBuilderArgs = do diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 055bf0c5c0..fc9985ef67 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -16,6 +16,7 @@ import Oracles.PackageData import Oracles.Setting import Settings import UserSettings +import GHC.Packages import Types.ConfiguredCabal as ConfCabal diff --git a/src/Settings/Builders/DeriveConstants.hs b/src/Settings/Builders/DeriveConstants.hs index 7a6e863e9c..939691a78f 100644 --- a/src/Settings/Builders/DeriveConstants.hs +++ b/src/Settings/Builders/DeriveConstants.hs @@ -1,6 +1,7 @@ module Settings.Builders.DeriveConstants (deriveConstantsBuilderArgs) where import Settings.Builders.Common +import Builder -- TODO: do we need to support `includes_CC_OPTS += -DDYNAMIC_BY_DEFAULT`? deriveConstantsBuilderArgs :: Args diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 2a94f2e4dd..87d5d62a5f 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -2,11 +2,13 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal -import Flavour +import Types.Flavour import Rules.Gmp import Settings.Builders.Common import Types.ConfiguredCabal as ConfCabal import Settings.Warnings +import GHC.Packages +import GHC ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 6c2de686c6..0c35dc7f6b 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -5,9 +5,12 @@ module Settings.Builders.GhcCabal ( import Hadrian.Haskell.Cabal import Context -import Flavour +import Types.Flavour import Settings.Builders.Common import Data.Maybe (fromJust) +import Hadrian.Builder (getBuilderPath, needBuilder ) +import Builder ( ArMode ( Pack ) ) +import GHC.Packages ghcCabalBuilderArgs :: Args ghcCabalBuilderArgs = mconcat diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs index 4056d849b5..8e29df0fca 100644 --- a/src/Settings/Builders/GhcPkg.hs +++ b/src/Settings/Builders/GhcPkg.hs @@ -1,6 +1,7 @@ module Settings.Builders.GhcPkg (ghcPkgBuilderArgs) where import Settings.Builders.Common +import Builder () ghcPkgBuilderArgs :: Args ghcPkgBuilderArgs = mconcat diff --git a/src/Settings/Builders/Happy.hs b/src/Settings/Builders/Happy.hs index 5ffb2614cc..8eee4d9ee4 100644 --- a/src/Settings/Builders/Happy.hs +++ b/src/Settings/Builders/Happy.hs @@ -1,6 +1,7 @@ module Settings.Builders.Happy (happyBuilderArgs) where import Settings.Builders.Common +import Builder () happyBuilderArgs :: Args happyBuilderArgs = builder Happy ? mconcat [ arg "-agc" diff --git a/src/Settings/Builders/HsCpp.hs b/src/Settings/Builders/HsCpp.hs index aeb5255990..7ad0cd3bd6 100644 --- a/src/Settings/Builders/HsCpp.hs +++ b/src/Settings/Builders/HsCpp.hs @@ -1,6 +1,8 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where import Settings.Builders.Common +import Builder () +import GHC.Packages hsCppBuilderArgs :: Args hsCppBuilderArgs = builder HsCpp ? do diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 18a63b266a..c128c9f81c 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -2,6 +2,9 @@ module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where import Settings.Builders.Common import Types.ConfiguredCabal as ConfCabal +import GHC (autogenPath) +import Hadrian.Builder (getBuilderPath) +import Builder () hsc2hsBuilderArgs :: Args hsc2hsBuilderArgs = builder Hsc2Hs ? do diff --git a/src/Settings/Builders/Ld.hs b/src/Settings/Builders/Ld.hs index 2715bbb20c..c10eb76ac4 100644 --- a/src/Settings/Builders/Ld.hs +++ b/src/Settings/Builders/Ld.hs @@ -1,6 +1,7 @@ module Settings.Builders.Ld (ldBuilderArgs) where import Settings.Builders.Common +import Builder () ldBuilderArgs :: Args ldBuilderArgs = builder Ld ? mconcat [ getStagedSettingList ConfLdLinkerArgs diff --git a/src/Settings/Builders/Xelatex.hs b/src/Settings/Builders/Xelatex.hs index 5623284ed5..45db71f406 100644 --- a/src/Settings/Builders/Xelatex.hs +++ b/src/Settings/Builders/Xelatex.hs @@ -1,6 +1,8 @@ module Settings.Builders.Xelatex (xelatexBuilderArgs) where import Settings.Builders.Common +import Hadrian.Expression (getInput) +import Builder () xelatexBuilderArgs :: Args xelatexBuilderArgs = builder Xelatex ? mconcat [ arg "-halt-on-error" diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index b5673e8592..b0446fd512 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -10,7 +10,7 @@ import qualified Hadrian.Builder.Tar import CommandLine import Expression -import Flavour +import Types.Flavour import Oracles.Flag import Settings import Settings.Builders.Alex @@ -45,6 +45,10 @@ import Settings.Warnings import Types.ConfiguredCabal as ConfCabal +import {-# SOURCE #-} Builder +import GHC.Packages +import GHC + -- TODO: Move C source arguments here -- | Default and package-specific source arguments. data SourceArgs = SourceArgs diff --git a/src/Settings/Default.hs-boot b/src/Settings/Default.hs-boot index 468c5cae3e..82d12f2ae1 100644 --- a/src/Settings/Default.hs-boot +++ b/src/Settings/Default.hs-boot @@ -3,8 +3,8 @@ module Settings.Default ( defaultArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultSplitObjects ) where -import Flavour -import Expression +import Types.Flavour +import Types.Expression data SourceArgs = SourceArgs { hsDefault :: Args diff --git a/src/Settings/Flavours/Development.hs b/src/Settings/Flavours/Development.hs index 5919026cb0..db7170a710 100644 --- a/src/Settings/Flavours/Development.hs +++ b/src/Settings/Flavours/Development.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Development (developmentFlavour) where import Expression -import Flavour +import Types.Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/Performance.hs b/src/Settings/Flavours/Performance.hs index 64ab4bce9d..e5117d1a01 100644 --- a/src/Settings/Flavours/Performance.hs +++ b/src/Settings/Flavours/Performance.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Performance (performanceFlavour) where import Expression -import Flavour +import Types.Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/Profiled.hs b/src/Settings/Flavours/Profiled.hs index d56cc10055..eec869d7b3 100644 --- a/src/Settings/Flavours/Profiled.hs +++ b/src/Settings/Flavours/Profiled.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Profiled (profiledFlavour) where import Expression -import Flavour +import Types.Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs index a4f30a1e29..034e240265 100644 --- a/src/Settings/Flavours/Quick.hs +++ b/src/Settings/Flavours/Quick.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Quick (quickFlavour) where import Expression -import Flavour +import Types.Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/QuickCross.hs b/src/Settings/Flavours/QuickCross.hs index 3d0c410bea..da07bd7f0d 100644 --- a/src/Settings/Flavours/QuickCross.hs +++ b/src/Settings/Flavours/QuickCross.hs @@ -1,7 +1,7 @@ module Settings.Flavours.QuickCross (quickCrossFlavour) where import Expression -import Flavour +import Types.Flavour import Oracles.Flag import {-# SOURCE #-} Settings.Default diff --git a/src/Settings/Flavours/QuickCrossNg.hs b/src/Settings/Flavours/QuickCrossNg.hs index c07e84f62c..4fe6c4367b 100644 --- a/src/Settings/Flavours/QuickCrossNg.hs +++ b/src/Settings/Flavours/QuickCrossNg.hs @@ -1,7 +1,7 @@ module Settings.Flavours.QuickCrossNG (quickCrossNGFlavour) where import Expression -import Flavour +import Types.Flavour import Oracles.Flag import {-# SOURCE #-} Settings.Default diff --git a/src/Settings/Flavours/Quickest.hs b/src/Settings/Flavours/Quickest.hs index a9dfb7087f..abcb70ae60 100644 --- a/src/Settings/Flavours/Quickest.hs +++ b/src/Settings/Flavours/Quickest.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Quickest (quickestFlavour) where import Expression -import Flavour +import Types.Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Packages/Base.hs b/src/Settings/Packages/Base.hs index c975762b18..ed956ecf0f 100644 --- a/src/Settings/Packages/Base.hs +++ b/src/Settings/Packages/Base.hs @@ -2,6 +2,7 @@ module Settings.Packages.Base (basePackageArgs) where import Expression import Settings +import GHC.Packages basePackageArgs :: Args basePackageArgs = package base ? do diff --git a/src/Settings/Packages/Cabal.hs b/src/Settings/Packages/Cabal.hs index c01be4b3ed..2f3ee9e004 100644 --- a/src/Settings/Packages/Cabal.hs +++ b/src/Settings/Packages/Cabal.hs @@ -1,6 +1,7 @@ module Settings.Packages.Cabal where import Expression +import GHC.Packages cabalPackageArgs :: Args cabalPackageArgs = package cabal ? diff --git a/src/Settings/Packages/Compiler.hs b/src/Settings/Packages/Compiler.hs index 5a97e55d6c..52116bc63b 100644 --- a/src/Settings/Packages/Compiler.hs +++ b/src/Settings/Packages/Compiler.hs @@ -2,10 +2,11 @@ module Settings.Packages.Compiler (compilerPackageArgs) where import Base import Expression -import Flavour +import Types.Flavour import Oracles.Flag import Oracles.Setting import Settings +import GHC.Packages compilerPackageArgs :: Args compilerPackageArgs = package compiler ? do diff --git a/src/Settings/Packages/Ghc.hs b/src/Settings/Packages/Ghc.hs index 071260ec83..73749b13cb 100644 --- a/src/Settings/Packages/Ghc.hs +++ b/src/Settings/Packages/Ghc.hs @@ -3,6 +3,7 @@ module Settings.Packages.Ghc (ghcPackageArgs) where import Expression import Oracles.Setting import Oracles.Flag (crossCompiling) +import GHC.Packages ghcPackageArgs :: Args ghcPackageArgs = package ghc ? do diff --git a/src/Settings/Packages/GhcPkg.hs b/src/Settings/Packages/GhcPkg.hs index 586d67243e..0e68b5e367 100644 --- a/src/Settings/Packages/GhcPkg.hs +++ b/src/Settings/Packages/GhcPkg.hs @@ -2,6 +2,7 @@ module Settings.Packages.GhcPkg (ghcPkgPackageArgs) where import Expression import Oracles.Flag (crossCompiling) +import GHC.Packages ghcPkgPackageArgs :: Args ghcPkgPackageArgs = package ghcPkg ? builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" diff --git a/src/Settings/Packages/GhcPrim.hs b/src/Settings/Packages/GhcPrim.hs index e224f89a80..917a438265 100644 --- a/src/Settings/Packages/GhcPrim.hs +++ b/src/Settings/Packages/GhcPrim.hs @@ -2,6 +2,7 @@ module Settings.Packages.GhcPrim (ghcPrimPackageArgs) where import Oracles.Flag import Expression +import GHC.Packages ghcPrimPackageArgs :: Args ghcPrimPackageArgs = package ghcPrim ? mconcat diff --git a/src/Settings/Packages/Ghci.hs b/src/Settings/Packages/Ghci.hs index 3fcbfb27b1..6c0ae20f8e 100644 --- a/src/Settings/Packages/Ghci.hs +++ b/src/Settings/Packages/Ghci.hs @@ -1,6 +1,7 @@ module Settings.Packages.Ghci (ghciPackageArgs) where import Expression +import GHC.Packages ghciPackageArgs :: Args ghciPackageArgs = package ghci ? notStage0 ? builder CabalFlags ? arg "ghci" diff --git a/src/Settings/Packages/Haddock.hs b/src/Settings/Packages/Haddock.hs index b1c76b2d26..deadae2f9e 100644 --- a/src/Settings/Packages/Haddock.hs +++ b/src/Settings/Packages/Haddock.hs @@ -1,6 +1,7 @@ module Settings.Packages.Haddock (haddockPackageArgs) where import Expression +import GHC.Packages haddockPackageArgs :: Args haddockPackageArgs = diff --git a/src/Settings/Packages/Haskeline.hs b/src/Settings/Packages/Haskeline.hs index 629f1f3eab..65fe59eb89 100644 --- a/src/Settings/Packages/Haskeline.hs +++ b/src/Settings/Packages/Haskeline.hs @@ -2,6 +2,7 @@ module Settings.Packages.Haskeline (haskelinePackageArgs) where import Expression import Oracles.Flag (crossCompiling) +import GHC.Packages haskelinePackageArgs :: Args haskelinePackageArgs = diff --git a/src/Settings/Packages/Hsc2Hs.hs b/src/Settings/Packages/Hsc2Hs.hs index e5aa8bbc96..8480526f15 100644 --- a/src/Settings/Packages/Hsc2Hs.hs +++ b/src/Settings/Packages/Hsc2Hs.hs @@ -1,6 +1,7 @@ module Settings.Packages.Hsc2Hs (hsc2hsPackageArgs) where import Expression +import GHC.Packages hsc2hsPackageArgs :: Args hsc2hsPackageArgs = diff --git a/src/Settings/Packages/IntegerGmp.hs b/src/Settings/Packages/IntegerGmp.hs index e830411547..a5593ada86 100644 --- a/src/Settings/Packages/IntegerGmp.hs +++ b/src/Settings/Packages/IntegerGmp.hs @@ -3,6 +3,7 @@ module Settings.Packages.IntegerGmp (integerGmpPackageArgs) where import Base import Expression import Rules.Gmp +import GHC.Packages -- TODO: Is this needed? -- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES" diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index 9bb01d7803..1183d69298 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -7,6 +7,7 @@ import Expression import Oracles.Flag import Oracles.Setting import Settings +import GHC.Packages -- | RTS is considered a Stage1 package. This determines RTS build directory. rtsContext :: Context diff --git a/src/Settings/Packages/RunGhc.hs b/src/Settings/Packages/RunGhc.hs index 03a19c8373..a10633f070 100644 --- a/src/Settings/Packages/RunGhc.hs +++ b/src/Settings/Packages/RunGhc.hs @@ -2,6 +2,7 @@ module Settings.Packages.RunGhc (runGhcPackageArgs) where import Oracles.Setting import Expression +import GHC.Packages runGhcPackageArgs :: Args runGhcPackageArgs = package runGhc ? builder Ghc ? input "//Main.hs" ? do diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index 927870cf2d..aea1310025 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -4,6 +4,7 @@ import Expression import Oracles.Flag import Oracles.Setting import Settings +import GHC.Packages -- See @mk/warnings.mk@ for warning-related arguments in the Make build system. diff --git a/src/Flavour.hs b/src/Types/Flavour.hs similarity index 90% rename from src/Flavour.hs rename to src/Types/Flavour.hs index fcbbb70d45..efdd7c5161 100644 --- a/src/Flavour.hs +++ b/src/Types/Flavour.hs @@ -1,6 +1,9 @@ -module Flavour (Flavour (..)) where +module Types.Flavour (Flavour (..)) where -import Expression +import Types.Expression +import Types.Stage +import Types.Package +import Development.Shake -- Please update doc/{flavours.md, user-settings.md} when changing this file. -- | 'Flavour' is a collection of build settings that fully define a GHC build. diff --git a/src/UserSettings.hs b/src/UserSettings.hs index 1b7c3f8bdd..d82b290429 100644 --- a/src/UserSettings.hs +++ b/src/UserSettings.hs @@ -10,7 +10,8 @@ module UserSettings ( import Hadrian.Utilities import System.Console.ANSI -import Flavour +import Types.Flavour +import Types.Package import Expression import {-# SOURCE #-} Settings.Default diff --git a/src/Utilities.hs b/src/Utilities.hs index 894c2e4c41..fec7ca72e5 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -13,6 +13,8 @@ import Expression hiding (stage) import Settings import Target import Types.ConfiguredCabal as ConfCabal +import Oracles.Setting (windowsHost) +import GHC.Packages build :: Target -> Action () build target = H.build target getArgs @@ -65,6 +67,11 @@ libraryTargets includeGhciLib context = do 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 () needLibrary cs = need =<< mapM pkgConfFile cs From cde14bef13503bb89e26e081e76af897ea89f292 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 15 Nov 2017 22:20:06 +0800 Subject: [PATCH 126/210] Explicit Build Root See #460. This tries to get rid of all `"//"` prefixes and replaces them by the explicit build root. --- src/Hadrian/Utilities.hs | 15 +++++- src/Rules/Compile.hs | 3 +- src/Rules/Dependencies.hs | 5 +- src/Rules/Documentation.hs | 18 ++++--- src/Rules/Generate.hs | 106 +++++++++++++++++++------------------ src/Rules/Gmp.hs | 11 ++-- src/Rules/Libffi.hs | 9 ++-- src/Rules/Library.hs | 12 +++-- src/Rules/PackageData.hs | 3 +- src/Rules/Program.hs | 4 +- src/Rules/Register.hs | 7 +-- 11 files changed, 113 insertions(+), 80 deletions(-) diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index 186d1b95d0..135ba43031 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -13,7 +13,7 @@ module Hadrian.Utilities ( insertExtra, lookupExtra, userSetting, -- * Paths - BuildRoot (..), buildRoot, isGeneratedSource, + BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource, -- * File system operations copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile, @@ -166,6 +166,14 @@ userSetting defaultValue = do extra <- shakeExtra <$> getShakeOptions return $ lookupExtra defaultValue extra +-- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the +-- setting is not found, return the provided default value instead. +userSettingRules :: Typeable a => a -> Rules a +userSettingRules defaultValue = do + extra <- shakeExtra <$> getShakeOptionsRules + return $ lookupExtra defaultValue extra + + newtype BuildRoot = BuildRoot FilePath deriving (Show, Eq, Typeable) -- | All build results are put into the 'buildRoot' directory. @@ -174,6 +182,11 @@ buildRoot = do BuildRoot path <- userSetting (BuildRoot "") return path +buildRootRules :: Rules FilePath +buildRootRules = do + BuildRoot path <- userSettingRules (BuildRoot "") + return path + -- | A version of 'fmap' with flipped arguments. Useful for manipulating values -- in context, e.g. 'buildRoot', as in the example below. -- diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs index 6bdea523e0..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 = "//" ++ buildDir context + root <- buildRootRules + let dir = root -/- buildDir context nonHs extension = dir -/- extension "*" <.> osuf way compile compiler obj2src obj = do src <- obj2src context obj diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs index 4c7850b78d..d8e66f7c4f 100644 --- a/src/Rules/Dependencies.hs +++ b/src/Rules/Dependencies.hs @@ -13,7 +13,8 @@ import Utilities buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules () buildPackageDependencies rs context@Context {..} = do - "//" ++ contextDir context -/- ".dependencies.mk" %> \mk -> do + root <- buildRootRules + root -/- contextDir context -/- ".dependencies.mk" %> \mk -> do srcs <- hsSources context need srcs orderOnly =<< interpretInContext context generatedDependencies @@ -23,7 +24,7 @@ buildPackageDependencies rs context@Context {..} = do target context (Ghc FindHsDependencies stage) srcs [mk] removeFile $ mk <.> "bak" - "//" ++ contextDir context -/- ".dependencies" %> \deps -> do + root -/- contextDir context -/- ".dependencies" %> \deps -> do need [deps <.> "mk"] mkDeps <- readFile' (deps <.> "mk") writeFileChanged deps . unlines diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index f9882319ed..127b087945 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -82,7 +82,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 +94,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,7 +106,8 @@ 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 @@ -141,7 +144,8 @@ buildPackageDocumentation context@Context {..} = when (stage == Stage1) $ do copyDirectory "utils/haddock/haddock-api/resources/html" dir -- Per-package haddocks - "//" ++ pkgName package <.> "haddock" %> \file -> do + root <- buildRootRules + root -/- pkgName package <.> "haddock" %> \file -> do haddocks <- haddockDependencies context srcs <- hsSources context need $ srcs ++ haddocks ++ [haddockHtmlLib] @@ -163,7 +167,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 -/- path <.> "pdf" %> \file -> do let context = vanillaContext Stage0 docPackage withTempDir $ \dir -> do build $ target context (Sphinx Latex) [pathPath path] [dir] @@ -179,7 +184,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 205d43bcf2..c403795e4b 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -124,55 +124,55 @@ generate file context expr = do putSuccess $ "| Successfully generated " ++ file ++ "." generatePackageCode :: Context -> Rules () -generatePackageCode context@(Context stage pkg _) = +generatePackageCode context@(Context stage pkg _) = do + root <- buildRootRules let dir = buildDir context - generated f = ("//" ++ dir ++ "//*.hs") ?== f && not ("//autogen/*" ?== f) + 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) $ do "//" -/- dir -/- "Config.hs" %> go generateConfigHs - "//" ++ dir -/- "*.hs-incl" %> genPrimopCode context - when (pkg == ghcPrim) $ do ("//" ++ dir -/- "GHC/Prim.hs") %> genPrimopCode context - ("//" ++ dir -/- "GHC/PrimopWrappers.hs") %> genPrimopCode context - 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 - , root -/- versionsH 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 - "//compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH - "//" ++ platformH stage %> go generateGhcBootPlatformH - ("//" ++ versionsH stage) <~ return "compiler" - - when (pkg == rts) $ do - "//" ++ dir -/- "cmm/AutoApply.cmm" %> \file -> - build $ target context GenApply [] [file] - - -- XXX: this should be fixed properly, e.g. generated here on demand. - ("//" ++ dir -/- "DerivedConstants.h") <~ (buildRoot <&> (-/- generatedDir)) - ("//" ++ dir -/- "ghcautoconf.h") <~ (buildRoot <&> (-/- generatedDir)) - ("//" ++ dir -/- "ghcplatform.h") <~ (buildRoot <&> (-/- generatedDir)) - ("//" ++ dir -/- "ghcversion.h") <~ (buildRoot <&> (-/- generatedDir)) - when (pkg == integerGmp) $ do - ("//" ++ dir -/- "ghc-gmp.h") <~ (buildRoot <&> (-/- "include")) - where + 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 + , root -/- versionsH 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 + (root -/- versionsH stage) <~ return "compiler" + + 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 @@ -185,8 +185,9 @@ genPrimopCode context@(Context stage _pkg _) file = do copyRules :: Rules () copyRules = do + root <- buildRootRules forM_ [Stage0 ..] $ \stage -> do - let prefix = ("//" ++ stageString stage ++ "/" ++ "lib") + let prefix = ((root -/- stageString stage) -/- "lib") (prefix -/- "ghc-usage.txt") <~ return "driver" (prefix -/- "ghci-usage.txt" ) <~ return "driver" (prefix -/- "llvm-targets") <~ return "." @@ -200,16 +201,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 diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index 6858029d12..b7093c97e0 100644 --- a/src/Rules/Gmp.hs +++ b/src/Rules/Gmp.hs @@ -46,7 +46,8 @@ 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" if not windows && -- TODO: We don't use system GMP on Windows. Fix? @@ -66,13 +67,13 @@ 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] @@ -86,7 +87,7 @@ gmpRules = do -- 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"] @@ -94,7 +95,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/Libffi.hs b/src/Rules/Libffi.hs index 4edc0e8343..03b8a6cd14 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -47,11 +47,12 @@ configureEnvironment = do libffiRules :: Rules () libffiRules = do - fmap ("//rts/build" -/-) 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 @@ -76,7 +77,7 @@ libffiRules = do putSuccess "| Successfully built custom library 'libffi'" - "//libffi/build/Makefile.in" %> \mkIn -> do + root -/- "libffi/build/Makefile.in" %> \mkIn -> do libffiPath <- libffiBuildPath removeDirectory libffiPath tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" @@ -98,7 +99,7 @@ libffiRules = do fixFile mkIn (fixLibffiMakefile top) -- TODO: Get rid of hard-coded @libffi@. - "//libffi/build/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 1c5c2766ea..eca2bc0060 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -33,11 +33,12 @@ archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") -- the any of the lirbary artifacts. library :: Context -> Rules () library context@Context{..} = do + root <- buildRootRules pkgId <- case pkgCabalFile package of Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) - "//" ++ libDir context -/- pkgId -/- archive way pkgId %> \_ -> do + root -/- libDir context -/- pkgId -/- archive way pkgId %> \_ -> do need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) [pkgId] return () @@ -60,11 +61,12 @@ libraryObjects context@Context{..} = do buildDynamicLib :: Context -> Rules () buildDynamicLib context@Context{..} = do + root <- buildRootRules pkgId <- case pkgCabalFile package of Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) - let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgId + let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId -- OS X libPrefix ++ "*.dylib" %> buildDynamicLibUnix -- Linux @@ -79,11 +81,12 @@ buildDynamicLib context@Context{..} = do buildPackageLibrary :: Context -> Rules () buildPackageLibrary context@Context {..} = do + root <- buildRootRules pkgId <- case pkgCabalFile package of Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) - let libPrefix = "//" ++ buildDir context -/- "libHS" ++ pkgId + let libPrefix = root -/- buildDir context -/- "libHS" ++ pkgId archive = libPrefix ++ (waySuffix way <.> "a") archive %%> \a -> do objs <- libraryObjects context @@ -106,7 +109,8 @@ buildPackageGhciLibrary context@Context {..} = priority 2 $ do Just file -> liftIO $ parseCabalPkgId file Nothing -> return (pkgName package) - let libPrefix = "//" ++ buildDir context -/- "HS" ++ pkgId + root <- buildRootRules + let libPrefix = root -/- buildDir context -/- "HS" ++ pkgId o = libPrefix ++ "*" ++ (waySuffix way <.> "o") o %> \obj -> do objs <- allObjects context diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 9c5771eba6..8236214e4c 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -16,7 +16,8 @@ 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 + root <- buildRootRules + let dir = root -/- contextDir context -- TODO: Get rid of hardcoded file paths. dir -/- "setup-config" %> \_ -> do configurePackage context diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index c7220f93b1..1846aa434b 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -19,11 +19,13 @@ import GHC -- | TODO: Drop code duplication buildProgram :: [(Resource, Int)] -> Package -> Rules () buildProgram rs package = do + root <- buildRootRules forM_ [Stage0 ..] $ \stage -> do let context = vanillaContext stage package -- Rules for programs built in 'buildRoot' - "//" ++ stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do + root -/- stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do + liftIO . print $ bin when (package == hsc2hs) $ do -- hsc2hs needs the template-hsc.h file tmpl <- templateHscPath stage diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 9cf6ea7e53..940d9c6091 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -26,13 +26,14 @@ parseCabalName = readPToMaybe parse -- by running the @ghc-pkg@ utility. registerPackages :: [(Resource, Int)] -> Context -> Rules () registerPackages rs context@Context {..} = do - "//" ++ inplacePackageDbPath stage %> + root <- buildRootRules + root -/- inplacePackageDbPath stage %> buildStamp rs context - "//" ++ inplacePackageDbPath stage -/- packageDbStamp %> \stamp -> do + root -/- inplacePackageDbPath stage -/- packageDbStamp %> \stamp -> do writeFileLines stamp [] - "//" ++ inplacePackageDbPath stage -/- "*.conf" %> \conf -> do + root -/- inplacePackageDbPath stage -/- "*.conf" %> \conf -> do settings <- libPath context <&> (-/- "settings") platformConstants <- libPath context <&> (-/- "platformConstants") From aab96a387ef6d6837903de76962256e9cfb14350 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 15 Nov 2017 22:52:50 +0800 Subject: [PATCH 127/210] Fix GhcPkg CabalFlags --- src/Settings/Packages/GhcPkg.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Packages/GhcPkg.hs b/src/Settings/Packages/GhcPkg.hs index 0e68b5e367..b2ae8bcbaf 100644 --- a/src/Settings/Packages/GhcPkg.hs +++ b/src/Settings/Packages/GhcPkg.hs @@ -5,4 +5,4 @@ import Oracles.Flag (crossCompiling) import GHC.Packages ghcPkgPackageArgs :: Args -ghcPkgPackageArgs = package ghcPkg ? builder (GhcCabal Conf) ? crossCompiling ? arg "-f-terminfo" +ghcPkgPackageArgs = package ghcPkg ? builder CabalFlags ? crossCompiling ? arg "-terminfo" From e5fbb953fa78a98b4d6edef4e027751e0d561af4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 15 Nov 2017 23:24:35 +0800 Subject: [PATCH 128/210] Cleanup Part 1 --- src/Rules/Libffi.hs | 8 +-- src/Rules/Program.hs | 145 ++++++++++++++++++++++--------------------- 2 files changed, 78 insertions(+), 75 deletions(-) diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index 03b8a6cd14..bda3a67820 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -48,11 +48,11 @@ configureEnvironment = do libffiRules :: Rules () libffiRules = do root <- buildRootRules - fmap ((root -/- "rts/build") -/-) libffiDependencies &%> \_ -> do + fmap ((root "rts/build") -/-) libffiDependencies &%> \_ -> do libffiPath <- libffiBuildPath need [libffiPath -/- libffiLibrary] - root -/- libffiLibrary %> \_ -> do + root libffiLibrary %> \_ -> do useSystemFfi <- flag UseSystemFfi rtsPath <- rtsBuildPath if useSystemFfi @@ -77,7 +77,7 @@ libffiRules = do putSuccess "| Successfully built custom library 'libffi'" - root -/- "libffi/build/Makefile.in" %> \mkIn -> do + root "libffi/build/Makefile.in" %> \mkIn -> do libffiPath <- libffiBuildPath removeDirectory libffiPath tarball <- unifyPath . fromSingleton "Exactly one LibFFI tarball is expected" @@ -99,7 +99,7 @@ libffiRules = do fixFile mkIn (fixLibffiMakefile top) -- TODO: Get rid of hard-coded @libffi@. - root -/- "libffi/build/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/Program.hs b/src/Rules/Program.hs index 1846aa434b..4e5441213b 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -7,8 +7,9 @@ import Base import Context import Expression hiding (stage, way) import Oracles.ModuleFiles -import Oracles.Setting -import Rules.Wrappers +--import Oracles.Setting +import Oracles.Flag (crossCompiling) +--import Rules.Wrappers import Settings import Settings.Packages.Rts import Target @@ -25,77 +26,79 @@ buildProgram rs package = do -- Rules for programs built in 'buildRoot' root -/- stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do - liftIO . print $ bin - 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 - buildBinary rs bin =<< programContext stage package - + cross <- crossCompiling + case (package, cross, stage) of + (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> do + srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin")) + copyFile (srcDir -/- takeFileName bin) bin + _ -> do + 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 + buildBinary rs bin =<< programContext stage package -- Rules for the GHC package, which is built 'inplace' - - - -- 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 ++ ")." + -- -- 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 ++ ")." -- TODO: Get rid of the Paths_hsc2hs.o hack. buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () From 92f40774af55eef3c02e9fcfad6a67122cac961a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 13:32:02 +0800 Subject: [PATCH 129/210] Cross compilers use integer-simple by default. --- src/Settings/Flavours/QuickCross.hs | 2 ++ src/Settings/Flavours/QuickCrossNg.hs | 8 ++++---- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Settings/Flavours/QuickCross.hs b/src/Settings/Flavours/QuickCross.hs index da07bd7f0d..6b851d8b1c 100644 --- a/src/Settings/Flavours/QuickCross.hs +++ b/src/Settings/Flavours/QuickCross.hs @@ -4,12 +4,14 @@ import Expression import Types.Flavour import Oracles.Flag import {-# SOURCE #-} Settings.Default +import GHC.Packages -- Please update doc/flavours.md when changing this file. quickCrossFlavour :: Flavour quickCrossFlavour = defaultFlavour { name = "quick-cross" , args = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs + , integerLibrary = pure integerSimple , libraryWays = mconcat [ pure [vanilla] , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] } diff --git a/src/Settings/Flavours/QuickCrossNg.hs b/src/Settings/Flavours/QuickCrossNg.hs index 4fe6c4367b..293a417091 100644 --- a/src/Settings/Flavours/QuickCrossNg.hs +++ b/src/Settings/Flavours/QuickCrossNg.hs @@ -2,17 +2,17 @@ module Settings.Flavours.QuickCrossNG (quickCrossNGFlavour) where import Expression import Types.Flavour -import Oracles.Flag import {-# SOURCE #-} Settings.Default +import GHC.Packages -- Please update doc/flavours.md when changing this file. quickCrossNGFlavour :: Flavour quickCrossNGFlavour = defaultFlavour { name = "quick-cross-ng" , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs - , libraryWays = mconcat - [ pure [vanilla] - , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] } + , integerLibrary = pure integerSimple + , libraryWays = pure [vanilla] + } quickCrossNGArgs :: Args quickCrossNGArgs = sourceArgs SourceArgs From d47fab7183c765386e9bd104190281d248f54962 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 13:34:21 +0800 Subject: [PATCH 130/210] Clean up rules Use `` wherer needed. E.g. if we need to match `$build/../$tail` we need to use `root tail`. Where the missing part is usually the stage string. --- src/Rules/Generate.hs | 34 +++++++++++++++++----------------- src/Rules/Gmp.hs | 10 +++++----- src/Rules/Register.hs | 4 +--- 3 files changed, 23 insertions(+), 25 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index c403795e4b..deca181feb 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -138,11 +138,11 @@ generatePackageCode context@(Context stage pkg _) = do 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 + 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 @@ -157,21 +157,21 @@ generatePackageCode context@(Context stage pkg _) = do -- 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 - (root -/- versionsH stage) <~ return "compiler" + root "compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH + root platformH stage %> go generateGhcBootPlatformH + (root versionsH stage) <~ return "compiler" when (pkg == rts) $ do - root -/- dir -/- "cmm/AutoApply.cmm" %> \file -> + 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)) + (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")) + (root dir -/- "ghc-gmp.h") <~ (buildRoot <&> (-/- "include")) where pattern <~ mdir = pattern %> \file -> do dir <- mdir @@ -202,9 +202,9 @@ copyRules = do generateRules :: Rules () generateRules = do 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 + 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 diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index b7093c97e0..1e2f71fcb7 100644 --- a/src/Rules/Gmp.hs +++ b/src/Rules/Gmp.hs @@ -47,7 +47,7 @@ gmpRules :: Rules () gmpRules = do -- Copy appropriate GMP header and object files root <- buildRootRules - root -/- gmpLibraryH %> \header -> do + root gmpLibraryH %> \header -> do windows <- windowsHost configMk <- readFile' $ gmpBase -/- "config.mk" if not windows && -- TODO: We don't use system GMP on Windows. Fix? @@ -67,13 +67,13 @@ gmpRules = do copyFile (gmpPath -/- "gmp.h") (gmpPath -/- gmpLibraryInTreeH) -- Build in-tree GMP library - root -/- 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 - root -/- gmpLibraryInTreeH %> \_ -> do + root gmpLibraryInTreeH %> \_ -> do gmpPath <- gmpBuildPath need [gmpPath -/- gmpLibraryH] @@ -87,7 +87,7 @@ gmpRules = do -- Run GMP's configure script -- TODO: Get rid of hard-coded @gmp@. - root -/- "gmp/Makefile" %> \mk -> do + root "gmp/Makefile" %> \mk -> do env <- configureEnvironment gmpPath <- gmpBuildPath need [mk <.> "in"] @@ -95,7 +95,7 @@ gmpRules = do target gmpContext (Configure gmpPath) [mk <.> "in"] [mk] -- Extract in-tree GMP sources and apply patches - root -/- "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/Register.hs b/src/Rules/Register.hs index 940d9c6091..2b9fb9c7ca 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -6,7 +6,6 @@ import Context import GHC import Target import Utilities -import Oracles.Setting import Hadrian.Expression import Settings @@ -76,8 +75,7 @@ buildConf _ context@Context {..} _conf = do -- might need some package-db resource to limit read/write, -- see packageRules - top <- topDirectory - bldPath <- (top -/-) <$> buildPath context + bldPath <- buildPath context -- special package cases (these should ideally be rolled into cabal one way or the other) when (package == rts) $ From 796a118be2a28945cb02fc6c54b5a1cc57966bd5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 13:35:05 +0800 Subject: [PATCH 131/210] ios *is* cross --- src/GHC.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 883b3dbc48..ecef40155b 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -36,7 +36,6 @@ defaultPackages Stage3 = return [] stage0Packages :: Action [Package] stage0Packages = do win <- windowsHost - ios <- iosHost cross <- crossCompiling return $ [ binary , cabal @@ -62,9 +61,9 @@ 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 From 6cfbc68eb04ce35a439bb006925d820a2af6c92f Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 13:35:16 +0800 Subject: [PATCH 132/210] Get the integer library from the flavour. --- src/GHC.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index ecef40155b..3f55672fa7 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -19,11 +19,11 @@ module GHC ( ) where import Base -import CommandLine import Context import Oracles.Flag import Oracles.Setting - +import Types.Flavour (integerLibrary) +import Settings (flavour) import GHC.Packages -- | Packages that are built by default. You can change this in "UserSettings". @@ -68,7 +68,7 @@ stage0Packages = do stage1Packages :: Action [Package] stage1Packages = do win <- windowsHost - intSimple <- cmdIntegerSimple + intLib <- integerLibrary =<< flavour libraries0 <- filter isLibrary <$> stage0Packages return $ libraries0 -- Build all Stage0 libraries in Stage1 ++ [ array @@ -84,7 +84,7 @@ stage1Packages = do , haskeline , hpcBin , hsc2hs - , if intSimple then integerSimple else integerGmp + , intLib , pretty , process , rts From 2bcd5ab393f9f0e5d7620cc5805b497f022ac46a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 14:12:44 +0800 Subject: [PATCH 133/210] Cleanup Package Settings. This is just getting hard to work with. --- hadrian.cabal | 13 +--- src/Settings/Default.hs | 26 +------ src/Settings/Packages.hs | 102 ++++++++++++++++++++++++++++ src/Settings/Packages/Base.hs | 13 ---- src/Settings/Packages/Cabal.hs | 11 --- src/Settings/Packages/Compiler.hs | 47 ------------- src/Settings/Packages/Ghc.hs | 14 ---- src/Settings/Packages/GhcPkg.hs | 8 --- src/Settings/Packages/GhcPrim.hs | 13 ---- src/Settings/Packages/Ghci.hs | 7 -- src/Settings/Packages/Haddock.hs | 8 --- src/Settings/Packages/Haskeline.hs | 9 --- src/Settings/Packages/Hsc2Hs.hs | 8 --- src/Settings/Packages/IntegerGmp.hs | 26 ------- src/Settings/Packages/RunGhc.hs | 10 --- 15 files changed, 105 insertions(+), 210 deletions(-) create mode 100644 src/Settings/Packages.hs delete mode 100644 src/Settings/Packages/Base.hs delete mode 100644 src/Settings/Packages/Cabal.hs delete mode 100644 src/Settings/Packages/Compiler.hs delete mode 100644 src/Settings/Packages/Ghc.hs delete mode 100644 src/Settings/Packages/GhcPkg.hs delete mode 100644 src/Settings/Packages/GhcPrim.hs delete mode 100644 src/Settings/Packages/Ghci.hs delete mode 100644 src/Settings/Packages/Haddock.hs delete mode 100644 src/Settings/Packages/Haskeline.hs delete mode 100644 src/Settings/Packages/Hsc2Hs.hs delete mode 100644 src/Settings/Packages/IntegerGmp.hs delete mode 100644 src/Settings/Packages/RunGhc.hs diff --git a/hadrian.cabal b/hadrian.cabal index 07bbbc1a9f..6219a6952d 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -88,19 +88,8 @@ executable hadrian , Settings.Flavours.QuickCross , Settings.Flavours.QuickCrossNG , Settings.Flavours.Quickest - , Settings.Packages.Base - , Settings.Packages.Cabal - , Settings.Packages.Compiler - , Settings.Packages.Ghc - , Settings.Packages.Ghci - , Settings.Packages.GhcPkg - , Settings.Packages.GhcPrim - , Settings.Packages.Haddock - , Settings.Packages.Hsc2Hs - , Settings.Packages.Haskeline - , Settings.Packages.IntegerGmp + , Settings.Packages , Settings.Packages.Rts - , Settings.Packages.RunGhc , Settings.Warnings , Stage , Types.Context diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index b0446fd512..bf20d5eeba 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -28,19 +28,8 @@ import Settings.Builders.HsCpp import Settings.Builders.Ld import Settings.Builders.Make import Settings.Builders.Xelatex -import Settings.Packages.Base -import Settings.Packages.Cabal -import Settings.Packages.Compiler -import Settings.Packages.Ghc -import Settings.Packages.Ghci -import Settings.Packages.GhcPkg -import Settings.Packages.GhcPrim -import Settings.Packages.Haddock -import Settings.Packages.Hsc2Hs -import Settings.Packages.Haskeline -import Settings.Packages.IntegerGmp +import Settings.Packages import Settings.Packages.Rts -import Settings.Packages.RunGhc import Settings.Warnings import Types.ConfiguredCabal as ConfCabal @@ -164,17 +153,6 @@ defaultBuilderArgs = mconcat -- | All 'Package'-dependent command line arguments. defaultPackageArgs :: Args defaultPackageArgs = mconcat - [ basePackageArgs - , cabalPackageArgs - , compilerPackageArgs - , ghciPackageArgs - , ghcPackageArgs - , ghcPkgPackageArgs - , ghcPrimPackageArgs - , haddockPackageArgs - , hsc2hsPackageArgs - , haskelinePackageArgs - , integerGmpPackageArgs + [ packageArgs , rtsPackageArgs - , runGhcPackageArgs , warningArgs ] diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs new file mode 100644 index 0000000000..1b7cdd5b28 --- /dev/null +++ b/src/Settings/Packages.hs @@ -0,0 +1,102 @@ +module Settings.Packages (packageArgs) where + +import Expression +import Settings +import Types.Flavour +import Oracles.Setting +import Oracles.Flag +import GHC.Packages +import Rules.Gmp + +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 + ? builder CabalFlags ? intLibPkg == integerSimple ? arg "integer-simple" + , 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" + , (threaded `elem` 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" ] + , package ghci ? notStage0 ? 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] + ] diff --git a/src/Settings/Packages/Base.hs b/src/Settings/Packages/Base.hs deleted file mode 100644 index ed956ecf0f..0000000000 --- a/src/Settings/Packages/Base.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Settings.Packages.Base (basePackageArgs) where - -import Expression -import Settings -import GHC.Packages - -basePackageArgs :: Args -basePackageArgs = package base ? do - integerLibraryName <- pkgName <$> getIntegerPackage - 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" ] diff --git a/src/Settings/Packages/Cabal.hs b/src/Settings/Packages/Cabal.hs deleted file mode 100644 index 2f3ee9e004..0000000000 --- a/src/Settings/Packages/Cabal.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Settings.Packages.Cabal where - -import Expression -import GHC.Packages - -cabalPackageArgs :: Args -cabalPackageArgs = 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" diff --git a/src/Settings/Packages/Compiler.hs b/src/Settings/Packages/Compiler.hs deleted file mode 100644 index 52116bc63b..0000000000 --- a/src/Settings/Packages/Compiler.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Settings.Packages.Compiler (compilerPackageArgs) where - -import Base -import Expression -import Types.Flavour -import Oracles.Flag -import Oracles.Setting -import Settings -import GHC.Packages - -compilerPackageArgs :: Args -compilerPackageArgs = package compiler ? do - stage <- getStage - rtsWays <- getRtsWays - path <- getBuildPath - 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" - , (threaded `elem` 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) ] diff --git a/src/Settings/Packages/Ghc.hs b/src/Settings/Packages/Ghc.hs deleted file mode 100644 index 73749b13cb..0000000000 --- a/src/Settings/Packages/Ghc.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Settings.Packages.Ghc (ghcPackageArgs) where - -import Expression -import Oracles.Setting -import Oracles.Flag (crossCompiling) -import GHC.Packages - -ghcPackageArgs :: Args -ghcPackageArgs = package ghc ? do - stage <- getStage - path <- expr $ buildPath (vanillaContext stage compiler) - mconcat [ builder Ghc ? arg ("-I" ++ path) - , builder CabalFlags ? ghcWithInterpreter ? notStage0 ? arg "ghci" - , builder CabalFlags ? crossCompiling ? arg "-terminfo" ] diff --git a/src/Settings/Packages/GhcPkg.hs b/src/Settings/Packages/GhcPkg.hs deleted file mode 100644 index b2ae8bcbaf..0000000000 --- a/src/Settings/Packages/GhcPkg.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Settings.Packages.GhcPkg (ghcPkgPackageArgs) where - -import Expression -import Oracles.Flag (crossCompiling) -import GHC.Packages - -ghcPkgPackageArgs :: Args -ghcPkgPackageArgs = package ghcPkg ? builder CabalFlags ? crossCompiling ? arg "-terminfo" diff --git a/src/Settings/Packages/GhcPrim.hs b/src/Settings/Packages/GhcPrim.hs deleted file mode 100644 index 917a438265..0000000000 --- a/src/Settings/Packages/GhcPrim.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Settings.Packages.GhcPrim (ghcPrimPackageArgs) where - -import Oracles.Flag -import Expression -import GHC.Packages - -ghcPrimPackageArgs :: Args -ghcPrimPackageArgs = package ghcPrim ? mconcat - [ builder CabalFlags ? arg "include-ghc-prim" - - , builder (Cc CompileC) ? - (not <$> flag GccIsClang) ? - input "//cbits/atomic.c" ? arg "-Wno-sync-nand" ] diff --git a/src/Settings/Packages/Ghci.hs b/src/Settings/Packages/Ghci.hs deleted file mode 100644 index 6c0ae20f8e..0000000000 --- a/src/Settings/Packages/Ghci.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Settings.Packages.Ghci (ghciPackageArgs) where - -import Expression -import GHC.Packages - -ghciPackageArgs :: Args -ghciPackageArgs = package ghci ? notStage0 ? builder CabalFlags ? arg "ghci" diff --git a/src/Settings/Packages/Haddock.hs b/src/Settings/Packages/Haddock.hs deleted file mode 100644 index deadae2f9e..0000000000 --- a/src/Settings/Packages/Haddock.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Settings.Packages.Haddock (haddockPackageArgs) where - -import Expression -import GHC.Packages - -haddockPackageArgs :: Args -haddockPackageArgs = - package haddock ? builder CabalFlags ? arg "in-ghc-tree" diff --git a/src/Settings/Packages/Haskeline.hs b/src/Settings/Packages/Haskeline.hs deleted file mode 100644 index 65fe59eb89..0000000000 --- a/src/Settings/Packages/Haskeline.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Settings.Packages.Haskeline (haskelinePackageArgs) where - -import Expression -import Oracles.Flag (crossCompiling) -import GHC.Packages - -haskelinePackageArgs :: Args -haskelinePackageArgs = - package haskeline ? builder CabalFlags ? crossCompiling ? arg "-terminfo" diff --git a/src/Settings/Packages/Hsc2Hs.hs b/src/Settings/Packages/Hsc2Hs.hs deleted file mode 100644 index 8480526f15..0000000000 --- a/src/Settings/Packages/Hsc2Hs.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Settings.Packages.Hsc2Hs (hsc2hsPackageArgs) where - -import Expression -import GHC.Packages - -hsc2hsPackageArgs :: Args -hsc2hsPackageArgs = - package hsc2hs ? builder CabalFlags ? arg "in-ghc-tree" diff --git a/src/Settings/Packages/IntegerGmp.hs b/src/Settings/Packages/IntegerGmp.hs deleted file mode 100644 index a5593ada86..0000000000 --- a/src/Settings/Packages/IntegerGmp.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Settings.Packages.IntegerGmp (integerGmpPackageArgs) where - -import Base -import Expression -import Rules.Gmp -import GHC.Packages - --- TODO: Is this needed? --- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES" --- libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred --- endif -integerGmpPackageArgs :: Args -integerGmpPackageArgs = package integerGmp ? do - path <- expr gmpBuildPath - let includeGmp = "-I" ++ path -/- "include" - 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) ] ] diff --git a/src/Settings/Packages/RunGhc.hs b/src/Settings/Packages/RunGhc.hs deleted file mode 100644 index a10633f070..0000000000 --- a/src/Settings/Packages/RunGhc.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Settings.Packages.RunGhc (runGhcPackageArgs) where - -import Oracles.Setting -import Expression -import GHC.Packages - -runGhcPackageArgs :: Args -runGhcPackageArgs = package runGhc ? builder Ghc ? input "//Main.hs" ? do - version <- getSetting ProjectVersion - pure ["-cpp", "-DVERSION=" ++ show version] From 9f17f3a95188fb1ac0b8df2cb27da21cb7d66182 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 17:54:14 +0800 Subject: [PATCH 134/210] Cleanup Program Rules. --- src/Rules/Program.hs | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 4e5441213b..666d7426a9 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -26,21 +26,27 @@ buildProgram rs package = do -- Rules for programs built in 'buildRoot' root -/- stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do - cross <- crossCompiling - case (package, cross, stage) of - (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> do - srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin")) - copyFile (srcDir -/- takeFileName bin) bin - _ -> do - 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 - buildBinary rs bin =<< programContext stage package + + -- Custom dependencies: this should be modeled better in the cabal file somehow. + + 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 + + + cross <- crossCompiling + -- for cross compiler. copy the stage0/bin/ + -- into stage1/bin/ + case (package, cross, stage) of + (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> 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' -- -- Rules for other programs built in inplace directories From 70b8c95e61a040fed3a23a8f51044b5dad43957d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 17:54:27 +0800 Subject: [PATCH 135/210] Awe... flags are messed up with configured cabal. --- src/Hadrian/Haskell/Cabal/Parse.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index f42b1cb1be..3459cdb0a8 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -196,6 +196,14 @@ registerPackage context@Context {..} = do -- | 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 From 9f4362a63e2788be949a3c4032febb4b499b51e0 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Thu, 16 Nov 2017 17:54:41 +0800 Subject: [PATCH 136/210] Meh flags for text are messed up with integer-simple. --- src/Settings/Packages.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index 1b7cdd5b28..a2a7297045 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -33,7 +33,16 @@ packageArgs = do , package bytestring ? builder CabalFlags ? intLibPkg == integerSimple ? arg "integer-simple" , package text - ? builder CabalFlags ? intLibPkg == integerSimple ? arg "integer-simple" + -- 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 From b1e3969e437a90d12f51c3d24697c582fe986ef2 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 18 Nov 2017 17:26:15 +0800 Subject: [PATCH 137/210] Build ghc-pkg and unlit in stage1 --- src/GHC.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/GHC.hs b/src/GHC.hs index 3f55672fa7..c63f135c44 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -80,6 +80,7 @@ stage1Packages = do , filepath , ghc , ghcCompact + , ghcPkg , ghcPrim , haskeline , hpcBin @@ -91,6 +92,7 @@ stage1Packages = do , runGhc , stm , time + , unlit , xhtml ] ++ [ iservBin | not win ] ++ [ unix | not win ] From e648dc3e1b1875d758c4347ebd9482b3c2cd7236 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 18 Nov 2017 17:26:52 +0800 Subject: [PATCH 138/210] Add target triple for cross compilers. --- src/GHC.hs | 21 +++++--- src/Rules.hs | 11 ++-- src/Rules/Program.hs | 124 +++++++++++++------------------------------ 3 files changed, 57 insertions(+), 99 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index c63f135c44..9c7088fcb3 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -105,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" - | package == hpcBin = "hpc" - | package == runGhc = "runhaskell" - | package == iservBin = "ghc-iserv" - | otherwise = pkgName package +programName :: Context -> Action String +programName Context {..} = do + cross <- crossCompiling + targetPlatform <- setting TargetPlatform + 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. @@ -127,7 +131,8 @@ installStage pkg programPath :: Context -> Action FilePath programPath context@Context {..} = do path <- stageBinPath stage - return $ path -/- programName context <.> exe + 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 diff --git a/src/Rules.hs b/src/Rules.hs index 7a59060e77..dcd18be899 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -42,7 +42,7 @@ topLevelTargets = do -- stage2 and package up bin and lib. need ["stage2"] version <- setting ProjectVersion - cwd <- liftIO $ getCurrentDirectory + cwd <- liftIO getCurrentDirectory binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" baseDir <- buildRoot <&> (-/- stageString Stage1) buildWithCmdOptions [Cwd baseDir] $ @@ -53,8 +53,9 @@ topLevelTargets = do phony "stage2" $ do putNormal "Building stage2" - need =<< mapM (f Stage1) =<< stagePackages Stage1 - + targets <- mapM (f Stage1) =<< stagePackages Stage1 + liftIO . putStrLn . unlines $ map ("- " ++) targets + need targets where -- either the package databae config file for libraries or -- the programPath for programs. However this still does @@ -111,8 +112,8 @@ 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 Rules.Register.registerPackages writePackageDb (Context stage base vanilla) -- base is only a dummy here. diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 666d7426a9..d91deedd8d 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -18,93 +18,45 @@ import GHC.Packages import GHC -- | TODO: Drop code duplication -buildProgram :: [(Resource, Int)] -> Package -> Rules () -buildProgram rs package = do +buildProgram :: [(Resource, Int)] -> Rules () +buildProgram rs = do root <- buildRootRules - forM_ [Stage0 ..] $ \stage -> do - let context = vanillaContext stage package - - -- Rules for programs built in 'buildRoot' - root -/- stageString stage -/- "bin" -/- programName context <.> exe %> \bin -> do - - -- Custom dependencies: this should be modeled better in the cabal file somehow. - - 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 - - - cross <- crossCompiling - -- for cross compiler. copy the stage0/bin/ - -- into stage1/bin/ - case (package, cross, stage) of - (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> 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' - - -- -- 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 ++ ")." + forM_ [Stage0 ..] $ \stage -> + root -/- stageString stage -/- "bin" -/- "*" %> \bin -> do + + -- 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) + + case lookup (takeFileName bin) nameToCtxList of + Nothing -> fail "Unknown program" + Just (Context {..}) -> do + -- Rules for programs built in 'buildRoot' + + -- Custom dependencies: this should be modeled better in the cabal file somehow. + + 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 + + cross <- crossCompiling + -- for cross compiler. copy the stage0/bin/ + -- into stage1/bin/ + case (package, cross, stage) of + (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> 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' -- TODO: Get rid of the Paths_hsc2hs.o hack. buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () From 466e4a332e887a4c08b3a2a33d0842ac8ab3ffc2 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 19 Nov 2017 09:56:37 +0800 Subject: [PATCH 139/210] ghc-version -> ghcversion-file --- src/Settings/Builders/Ghc.hs | 2 +- src/Settings/Builders/GhcCabal.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 87d5d62a5f..6df95170ac 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -106,7 +106,7 @@ commonGhcArgs = do -- 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 ("-ghc-version=" ++ ghcVersion) + , (pkg == rts) ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion) , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getConfiguredCabalData ConfCabal.cppOpts diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 0c35dc7f6b..125487b5d2 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -105,7 +105,7 @@ configureArgs = do , conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull) , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage - , notStage0 ? (arg =<< ("--ghc-option=-ghc-version=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] + , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))] bootPackageConstraints :: Args bootPackageConstraints = stage0 ? do From 4bcdcbee9642fb3d2dd71c28dfdeadfbe758cf19 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 19 Nov 2017 15:20:18 +0800 Subject: [PATCH 140/210] [rts] no -Werror. Cross compilers break otherwise, due undefined defines defaulting to 0. --- src/Settings/Packages/Rts.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index 1183d69298..a6fe39736e 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -207,7 +207,7 @@ rtsPackageArgs = package rts ? do -- See @rts/ghc.mk@. rtsWarnings :: Args rtsWarnings = mconcat - [ pure ["-Wall", "-Werror"] + [ pure ["-Wall" ] -- , "-Werror"] , arg "-Wextra" , arg "-Wstrict-prototypes" , arg "-Wmissing-prototypes" From a8f4526f4f84897968d5580cbe916db116961282 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 19 Nov 2017 18:12:25 +0800 Subject: [PATCH 141/210] casing --- src/Settings/Flavours/{QuickCrossNg.hs => QuickCrossNG.hs} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/Settings/Flavours/{QuickCrossNg.hs => QuickCrossNG.hs} (100%) diff --git a/src/Settings/Flavours/QuickCrossNg.hs b/src/Settings/Flavours/QuickCrossNG.hs similarity index 100% rename from src/Settings/Flavours/QuickCrossNg.hs rename to src/Settings/Flavours/QuickCrossNG.hs From 7260f746adf2238498c3ad89d7e341c094de0d98 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 20 Nov 2017 15:41:18 +0800 Subject: [PATCH 142/210] Fix pkg. --- src/Utilities.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Utilities.hs b/src/Utilities.hs index 387faa22fa..6288de5a4d 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -48,7 +48,7 @@ contextDependencies ctx@Context {..} = do deps <- concatMapM step pkgs let newPkgs = nubOrd $ sort (deps ++ pkgs) if pkgs == newPkgs then return pkgs else go newPkgs - step pkg = pkgDependencies (ctx { package = pkg }) >>= \case + step pkg = pkgDependencies (ctx { Context.package = pkg }) >>= \case Nothing -> return [] -- Non-Cabal packages have no dependencies. Just deps -> do active <- sort <$> stagePackages depStage From 142e89c498d89e8203f100dc00a8f23df7630d81 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 20 Nov 2017 15:41:29 +0800 Subject: [PATCH 143/210] Yey, no more haddock custom logic! --- src/Rules/Program.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index d91deedd8d..cd656a0bd8 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -89,12 +89,10 @@ buildBinary rs bin context@Context {..} = do when (stage > Stage0) $ do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ rtsContext { way = w } | w <- ways ] - path <- contextPath context cSrcs <- interpretInContext context (getConfiguredCabalData ConfCabal.cSrcs) cObjs <- mapM (objectPath context) cSrcs hsObjs <- hsObjects context return $ cObjs ++ hsObjs - ++ [ path -/- "build" -/- "Paths_haddock.o" | package == haddock ] need binDeps buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin] synopsis <- pkgSynopsis context From 225139d87ea6f6bd7e319b4ffcbd59b551c6aa24 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 20 Nov 2017 15:41:42 +0800 Subject: [PATCH 144/210] Make haddock a stage1 target. --- src/GHC.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/GHC.hs b/src/GHC.hs index 9c7088fcb3..708481738c 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -93,7 +93,8 @@ stage1Packages = do , stm , time , unlit - , xhtml ] + , xhtml + , haddock ] ++ [ iservBin | not win ] ++ [ unix | not win ] ++ [ win32 | win ] From 64742516a52ddab52a29e9e36178d2a8ae4b95de Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 20 Nov 2017 15:41:48 +0800 Subject: [PATCH 145/210] Cleanup --- src/Hadrian/Haskell/Cabal/Parse.hs | 11 ++++------- src/Hadrian/Utilities.hs | 1 - 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 3459cdb0a8..29a7528a96 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -48,8 +48,6 @@ import Distribution.Simple (defaultMainWithHooksNoReadArgs, compilerFlavor, Comp import Distribution.Simple.Compiler (compilerInfo) import Hadrian.Package import Hadrian.Utilities -import System.FilePath -import System.Directory import qualified Distribution.ModuleName as ModuleName import Data.Maybe (maybeToList, fromMaybe ) import GHC.Packages (rts) @@ -61,13 +59,12 @@ import Types.ConfiguredCabal import Settings import Oracles.Setting -import Context.Paths - import Settings.Default import Context import Hadrian.Oracles.TextFile +import Base -- TODO: Use fine-grain tracking instead of tracking the whole Cabal file. -- | Haskell package metadata extracted from a Cabal file. @@ -143,7 +140,7 @@ configurePackage context@Context {..} = do -- plus a "./Setup test" hook. However, Cabal is also -- "Custom", but doesn't have a configure script. Just C.Custom -> - do configureExists <- liftIO $ doesFileExist (replaceFileName (unsafePkgCabalFile package) "configure") + do configureExists <- doesFileExist (replaceFileName (unsafePkgCabalFile package) "configure") if configureExists then pure Hooks.autoconfUserHooks else pure Hooks.simpleUserHooks @@ -174,14 +171,14 @@ copyPackage context@Context {..} = do top <- topDirectory ctxPath <- (top -/-) <$> Context.contextPath context - stgPath <- (top -/-) <$> stagePath context + pkgDbPath <- (top -/-) <$> packageDbPath stage let userHooks = Hooks.autoconfUserHooks copyHooks = userHooks hooks = copyHooks -- we would need `withCurrentDirectory (pkgPath package)` - liftIO $ defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--destdir", stgPath] + liftIO $ defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath] registerPackage :: Context -> Action () registerPackage context@Context {..} = do diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index 135ba43031..715330c892 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -173,7 +173,6 @@ userSettingRules defaultValue = do extra <- shakeExtra <$> getShakeOptionsRules return $ lookupExtra defaultValue extra - newtype BuildRoot = BuildRoot FilePath deriving (Show, Eq, Typeable) -- | All build results are put into the 'buildRoot' directory. From 20b0604b4e772e5dc2e84020bc90e1ed12932f64 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 11:32:10 +0800 Subject: [PATCH 146/210] Move the LLVMNG logic into their own flavours. --- hadrian.cabal | 1 + src/GHC.hs | 5 -- src/GHC/Packages.hs | 4 -- src/Settings.hs | 3 +- src/Settings/Flavours/Quick.hs | 2 +- src/Settings/Flavours/QuickCrossNG.hs | 50 ++++++++++++++++++- src/Settings/Flavours/QuickWithNG.hs | 71 +++++++++++++++++++++++++++ src/Settings/Warnings.hs | 36 -------------- 8 files changed, 124 insertions(+), 48 deletions(-) create mode 100644 src/Settings/Flavours/QuickWithNG.hs diff --git a/hadrian.cabal b/hadrian.cabal index 8dfc4a2324..06b6c53aef 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -85,6 +85,7 @@ executable hadrian , Settings.Flavours.Performance , Settings.Flavours.Profiled , Settings.Flavours.Quick + , Settings.Flavours.QuickWithNG , Settings.Flavours.QuickCross , Settings.Flavours.QuickCrossNG , Settings.Flavours.Quickest diff --git a/src/GHC.hs b/src/GHC.hs index 708481738c..4d665739b4 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -7,8 +7,6 @@ module GHC ( ghcSplit, 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, dataBitcode, dataBitcodeLlvm, - dataBitcodeEdsl, ghcPackages, isGhcPackage, defaultPackages, -- * Package information @@ -41,9 +39,6 @@ stage0Packages = do , cabal , compareSizes , compiler - , dataBitcode - , dataBitcodeLlvm - , dataBitcodeEdsl , deriveConstants , genapply , genprimopcode diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 0c3f5c4161..00211a7ac7 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -20,7 +20,6 @@ ghcPackages = , integerSimple, iservBin, libffi, mtl, parsec, parallel, pretty, primitive , process, rts, runGhc, stm, templateHaskell, terminfo, text, time, touchy , transformers, unlit, unix, win32, xhtml - , dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl ] -- TODO: Optimise by switching to sets of packages. @@ -36,9 +35,6 @@ cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" compiler = hsTop "ghc" `setPath` "compiler" containers = hsLib "containers" -dataBitcode = hsLib "data-bitcode" -dataBitcodeLlvm = hsLib "data-bitcode-llvm" -dataBitcodeEdsl = hsLib "data-bitcode-edsl" deepseq = hsLib "deepseq" deriveConstants = hsUtil "deriveConstants" directory = hsLib "directory" diff --git a/src/Settings.hs b/src/Settings.hs index 83e8071331..1000d03565 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -15,6 +15,7 @@ import Settings.Flavours.Quick import Settings.Flavours.Quickest import Settings.Flavours.QuickCross import Settings.Flavours.QuickCrossNG +import Settings.Flavours.QuickWithNG import UserSettings import GHC.Packages @@ -36,7 +37,7 @@ hadrianFlavours :: [Flavour] hadrianFlavours = [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2 , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour - , quickCrossFlavour, quickCrossNGFlavour ] + , quickCrossFlavour, quickCrossNGFlavour, quickWithNGFlavour ] flavour :: Action Flavour flavour = do diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs index 034e240265..b28d3e7b48 100644 --- a/src/Settings/Flavours/Quick.hs +++ b/src/Settings/Flavours/Quick.hs @@ -11,7 +11,7 @@ quickFlavour = defaultFlavour , args = defaultBuilderArgs <> quickArgs <> defaultPackageArgs , libraryWays = mconcat [ pure [vanilla] - -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] + , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] } quickArgs :: Args diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 293a417091..93f98c5d05 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -5,13 +5,61 @@ import Types.Flavour import {-# SOURCE #-} Settings.Default import GHC.Packages +llvmngPackages :: [Package] +llvmngPackages = [ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl ] + +dataBitcode = hsLib "data-bitcode" +dataBitcodeLlvm = hsLib "data-bitcode-llvm" +dataBitcodeEdsl = hsLib "data-bitcode-edsl" + +llvmngWarningArgs :: Args +llvmngWarningArgs = builder Ghc ? + mconcat [ package dataBitcode ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-type-defaults" + ] + , package dataBitcodeLlvm ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-unused-local-binds" + , "-Wno-overlapping-patterns" + , "-Wno-type-defaults" + ] + , package dataBitcodeEdsl ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-type-defaults" + , "-Wno-unused-local-binds" + , "-Wno-overlapping-patterns" + , "-Wno-type-defaults" + , "-Wno-missing-signatures" + ] + ] + -- Please update doc/flavours.md when changing this file. quickCrossNGFlavour :: Flavour quickCrossNGFlavour = defaultFlavour { name = "quick-cross-ng" - , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs + , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs <> llvmngWarningArgs , integerLibrary = pure integerSimple , libraryWays = pure [vanilla] + , packages = \stage -> packages defaultFlavour stage ++ llvmngPackages } quickCrossNGArgs :: Args diff --git a/src/Settings/Flavours/QuickWithNG.hs b/src/Settings/Flavours/QuickWithNG.hs new file mode 100644 index 0000000000..61f83cbaab --- /dev/null +++ b/src/Settings/Flavours/QuickWithNG.hs @@ -0,0 +1,71 @@ +module Settings.Flavours.QuickWithNG (quickWithNGFlavour) where + +import Expression +import Types.Flavour +import {-# SOURCE #-} Settings.Default + +llvmngPackages :: [Package] +llvmngPackages = [ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl ] + +dataBitcode = hsLib "data-bitcode" +dataBitcodeLlvm = hsLib "data-bitcode-llvm" +dataBitcodeEdsl = hsLib "data-bitcode-edsl" + +llvmngWarningArgs :: Args +llvmngWarningArgs = builder Ghc ? + mconcat [ package dataBitcode ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-type-defaults" + ] + , package dataBitcodeLlvm ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-unused-local-binds" + , "-Wno-overlapping-patterns" + , "-Wno-type-defaults" + ] + , package dataBitcodeEdsl ? pure [ "-Wno-name-shadowing" + , "-Wno-unused-top-binds" + , "-Wno-unused-matches" + , "-Wno-orphans" + , "-Wno-incomplete-patterns" + , "-Wno-unused-do-bind" + , "-Wno-unused-imports" + , "-Wno-missing-methods" + , "-Wno-type-defaults" + , "-Wno-unused-local-binds" + , "-Wno-overlapping-patterns" + , "-Wno-type-defaults" + , "-Wno-missing-signatures" + ] + ] + +-- Please update doc/flavours.md when changing this file. +quickWithNGFlavour :: Flavour +quickWithNGFlavour = defaultFlavour + { name = "quick-with-ng" + , args = defaultBuilderArgs <> quickWithNGArgs <> defaultPackageArgs <> llvmngWarningArgs + , libraryWays = mconcat + [ pure [vanilla] + -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] + ] + , packages = \stage -> packages defaultFlavour stage ++ llvmngPackages + } + +quickWithNGArgs :: Args +quickWithNGArgs = sourceArgs SourceArgs + { hsDefault = pure ["-O0", "-H64m"] + , hsLibrary = notStage0 ? arg "-O" + , hsCompiler = stage0 ? arg "-O" + , hsGhc = stage0 ? arg "-O" } diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index aea1310025..a4783afa5d 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -55,40 +55,4 @@ warningArgs = builder Ghc ? do , "-Wno-orphans" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] , package xhtml ? pure [ "-Wno-unused-imports" ] ] - , package dataBitcode ? pure [ "-Wno-name-shadowing" - , "-Wno-unused-top-binds" - , "-Wno-unused-matches" - , "-Wno-orphans" - , "-Wno-incomplete-patterns" - , "-Wno-unused-do-bind" - , "-Wno-unused-imports" - , "-Wno-missing-methods" - , "-Wno-type-defaults" - ] - , package dataBitcodeLlvm ? pure [ "-Wno-name-shadowing" - , "-Wno-unused-top-binds" - , "-Wno-unused-matches" - , "-Wno-orphans" - , "-Wno-incomplete-patterns" - , "-Wno-unused-do-bind" - , "-Wno-unused-imports" - , "-Wno-missing-methods" - , "-Wno-unused-local-binds" - , "-Wno-overlapping-patterns" - , "-Wno-type-defaults" - ] - , package dataBitcodeEdsl ? pure [ "-Wno-name-shadowing" - , "-Wno-unused-top-binds" - , "-Wno-unused-matches" - , "-Wno-orphans" - , "-Wno-incomplete-patterns" - , "-Wno-unused-do-bind" - , "-Wno-unused-imports" - , "-Wno-missing-methods" - , "-Wno-type-defaults" - , "-Wno-unused-local-binds" - , "-Wno-overlapping-patterns" - , "-Wno-type-defaults" - , "-Wno-missing-signatures" - ] ] From 165bb85222099ed5a6fddb32fdbac22e9b7072f4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 17:46:57 +0800 Subject: [PATCH 147/210] Drop submodules. --- .gitmodules | 6 ------ happy | 1 - shake | 1 - 3 files changed, 8 deletions(-) delete mode 160000 happy delete mode 160000 shake diff --git a/.gitmodules b/.gitmodules index 76693089f2..e69de29bb2 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,6 +0,0 @@ -[submodule "shake"] - path = shake - url = https://github.com/ndmitchell/shake.git -[submodule "happy"] - path = happy - url = https://github.com/simonmar/happy.git diff --git a/happy b/happy deleted file mode 160000 index f4bb3d6edf..0000000000 --- a/happy +++ /dev/null @@ -1 +0,0 @@ -Subproject commit f4bb3d6edfbb558f10b7be028f7f9f4d3109cb53 diff --git a/shake b/shake deleted file mode 160000 index 1d8e816d7e..0000000000 --- a/shake +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 1d8e816d7ebe531ae7d307198f1b3f88150a7040 From 5597d62e510ada1c7ea7412dedd2eef20973e82a Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 17:47:09 +0800 Subject: [PATCH 148/210] Add targetPlatform to bindist name. --- src/Rules.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Rules.hs b/src/Rules.hs index dcd18be899..43b0dcd331 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -45,11 +45,12 @@ topLevelTargets = do cwd <- liftIO getCurrentDirectory binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" baseDir <- buildRoot <&> (-/- stageString Stage1) + targetPlatform <- setting TargetPlatform buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) ["bin", "lib"] - [binDistDir -/- "ghc-" ++ version ++ ".tar.xz"] + [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] phony "stage2" $ do putNormal "Building stage2" From b94742ab9b26aefb0fabb72833a9badd8d882c19 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 21:01:08 +0800 Subject: [PATCH 149/210] Move LLVMNG stuff into their own flavours. This is *not* a user flavour. This is a custom flavour. I don't want to loose this with the subtree/submodule switch every time. Unearthed another issue: as we require to know all `knownPackages` before hand, we can't simply aggregate the packages from the flavours. That would be really nice to have. The only solution I see is to drop the generation of explicit rules in favour of generic rules, from which we then figure out the package based on the matched path. I'm not sure about the performance impact here though. --- src/GHC.hs | 1 + src/Rules/Register.hs | 10 +++++----- src/Settings.hs | 5 ++++- src/Settings/Default.hs | 1 + src/Settings/Flavours/Quick.hs | 1 + src/Settings/Flavours/QuickCrossNG.hs | 4 +++- src/Settings/Flavours/QuickWithNG.hs | 5 ++++- src/Types/Flavour.hs | 2 ++ 8 files changed, 21 insertions(+), 8 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 4d665739b4..2409ad7828 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -7,6 +7,7 @@ module GHC ( ghcSplit, 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, ghcPackages, isGhcPackage, defaultPackages, -- * Package information diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 2b9fb9c7ca..16547d4080 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -29,7 +29,7 @@ registerPackages rs context@Context {..} = do root -/- inplacePackageDbPath stage %> buildStamp rs context - root -/- inplacePackageDbPath stage -/- packageDbStamp %> \stamp -> do + root -/- inplacePackageDbPath stage -/- packageDbStamp %> \stamp -> writeFileLines stamp [] root -/- inplacePackageDbPath stage -/- "*.conf" %> \conf -> do @@ -40,17 +40,17 @@ registerPackages rs context@Context {..} = do let Just pkgName | takeBaseName conf == "rts" = Just "rts" | otherwise = fst <$> parseCabalName (takeBaseName conf) let Just pkg = findPackageByName pkgName - bootLibs <- filter isLibrary <$> (defaultPackages Stage0) + bootLibs <- filter isLibrary <$> stagePackages Stage0 case stage of - Stage0 | not (pkg `elem` bootLibs) -> copyConf rs (context { package = pkg }) conf - _ -> buildConf rs (context { package = pkg }) conf + Stage0 | pkg `notElem` bootLibs -> copyConf rs (context { package = pkg }) conf + _ -> buildConf rs (context { package = pkg }) conf 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 $ do + buildWithResources rs $ target context (GhcPkg Clone stage) [pkgName package] [conf] where diff --git a/src/Settings.hs b/src/Settings.hs index 1000d03565..39d8bbcfca 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -39,6 +39,9 @@ hadrianFlavours = , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour , quickCrossFlavour, quickCrossNGFlavour, quickWithNGFlavour ] +extraFlavourPackages :: [Package] +extraFlavourPackages = nub . sort $ concatMap extraPackages hadrianFlavours + flavour :: Action Flavour flavour = do flavourName <- fromMaybe "default" <$> cmdFlavour @@ -59,7 +62,7 @@ programContext stage pkg = do -- TODO: switch to Set Package as the order of packages should not matter? -- Otherwise we have to keep remembering to sort packages from time to time. knownPackages :: [Package] -knownPackages = sort $ ghcPackages ++ userPackages +knownPackages = sort $ ghcPackages ++ userPackages ++ extraFlavourPackages -- TODO: Speed up? Switch to Set? -- Note: this is slow but we keep it simple as there are just ~50 packages diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index bf20d5eeba..c80a6f1198 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -102,6 +102,7 @@ defaultFlavour :: Flavour defaultFlavour = Flavour { name = "default" , args = defaultArgs + , extraPackages = mempty , packages = defaultPackages , integerLibrary = (\x -> if x then integerSimple else integerGmp) <$> cmdIntegerSimple , libraryWays = defaultLibraryWays diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs index b28d3e7b48..ed357de023 100644 --- a/src/Settings/Flavours/Quick.hs +++ b/src/Settings/Flavours/Quick.hs @@ -3,6 +3,7 @@ module Settings.Flavours.Quick (quickFlavour) where import Expression import Types.Flavour import {-# SOURCE #-} Settings.Default +import Oracles.Flag (platformSupportsSharedLibs) -- Please update doc/flavours.md when changing this file. quickFlavour :: Flavour diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 93f98c5d05..bcd4f79d5a 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -8,6 +8,7 @@ import GHC.Packages llvmngPackages :: [Package] llvmngPackages = [ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl ] +dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl :: Package dataBitcode = hsLib "data-bitcode" dataBitcodeLlvm = hsLib "data-bitcode-llvm" dataBitcodeEdsl = hsLib "data-bitcode-edsl" @@ -59,7 +60,8 @@ quickCrossNGFlavour = defaultFlavour , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs <> llvmngWarningArgs , integerLibrary = pure integerSimple , libraryWays = pure [vanilla] - , packages = \stage -> packages defaultFlavour stage ++ llvmngPackages + , extraPackages = llvmngPackages + , packages = fmap (++ llvmngPackages) . packages defaultFlavour } quickCrossNGArgs :: Args diff --git a/src/Settings/Flavours/QuickWithNG.hs b/src/Settings/Flavours/QuickWithNG.hs index 61f83cbaab..3f187f6c3d 100644 --- a/src/Settings/Flavours/QuickWithNG.hs +++ b/src/Settings/Flavours/QuickWithNG.hs @@ -3,10 +3,12 @@ module Settings.Flavours.QuickWithNG (quickWithNGFlavour) where import Expression import Types.Flavour import {-# SOURCE #-} Settings.Default +import GHC.Packages llvmngPackages :: [Package] llvmngPackages = [ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl ] +dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl :: Package dataBitcode = hsLib "data-bitcode" dataBitcodeLlvm = hsLib "data-bitcode-llvm" dataBitcodeEdsl = hsLib "data-bitcode-edsl" @@ -60,7 +62,8 @@ quickWithNGFlavour = defaultFlavour [ pure [vanilla] -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] - , packages = \stage -> packages defaultFlavour stage ++ llvmngPackages + , extraPackages = llvmngPackages + , packages = fmap (++ llvmngPackages) . packages defaultFlavour } quickWithNGArgs :: Args diff --git a/src/Types/Flavour.hs b/src/Types/Flavour.hs index efdd7c5161..3a58c93d00 100644 --- a/src/Types/Flavour.hs +++ b/src/Types/Flavour.hs @@ -17,6 +17,8 @@ data Flavour = Flavour { name :: String, -- | Use these command line arguments. args :: Args, + -- | Extra packages, only active in this flavour. + extraPackages :: [Package], -- | Build these packages. packages :: Stage -> Action [Package], -- | Either 'integerGmp' or 'integerSimple'. From 341d9625478d09b47b083494f9865bcaa9d58475 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 21:50:05 +0800 Subject: [PATCH 150/210] Nuke Oracles.PackageData --- hadrian.cabal | 1 - src/Oracles/PackageData.hs | 64 --------------------------------- src/Rules.hs | 2 +- src/Rules/Documentation.hs | 6 ++-- src/Rules/Library.hs | 2 +- src/Rules/PackageData.hs | 55 +--------------------------- src/Rules/Program.hs | 25 +------------ src/Settings/Builders/Common.hs | 2 -- 8 files changed, 6 insertions(+), 151 deletions(-) delete mode 100644 src/Oracles/PackageData.hs diff --git a/hadrian.cabal b/hadrian.cabal index 06b6c53aef..1c419c3685 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -44,7 +44,6 @@ executable hadrian , Oracles.Flag , Oracles.Setting , Oracles.ModuleFiles - , Oracles.PackageData , Rules , Rules.Clean , Rules.Compile diff --git a/src/Oracles/PackageData.hs b/src/Oracles/PackageData.hs deleted file mode 100644 index feaa3326ac..0000000000 --- a/src/Oracles/PackageData.hs +++ /dev/null @@ -1,64 +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 - | 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" - 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/Rules.hs b/src/Rules.hs index 43b0dcd331..3569c186a7 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -61,7 +61,7 @@ topLevelTargets = do -- 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 lirbary /and/ a program. + -- 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 diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 127b087945..d605e21cac 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -11,7 +11,6 @@ import Context import Types.Flavour import GHC import Oracles.ModuleFiles -import Oracles.PackageData import Settings import Target import Utilities @@ -125,9 +124,8 @@ haddockHtmlLib = "inplace/lib/html/haddock-util.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 +haddockDependencies _context = do + depNames <- pure $ error "lookup DEP_NAMES via configuredCabalData" -- pkgDataList $ DepNames path sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index eca2bc0060..5aed5e7af5 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -30,7 +30,7 @@ archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") -- -- So we'll assume rules to build all the -- package artifacts, and provide rules for --- the any of the lirbary artifacts. +-- the any of the library artifacts. library :: Context -> Rules () library context@Context{..} = do root <- buildRootRules diff --git a/src/Rules/PackageData.hs b/src/Rules/PackageData.hs index 8236214e4c..087b17a380 100644 --- a/src/Rules/PackageData.hs +++ b/src/Rules/PackageData.hs @@ -3,13 +3,10 @@ module Rules.PackageData (buildPackageData) where import Base import Context import Expression -import Oracles.Setting -import Rules.Generate import Settings.Packages.Rts import Target import Utilities import GHC.Packages -import GHC import Hadrian.Haskell.Cabal.Parse (configurePackage) @@ -19,7 +16,7 @@ buildPackageData context@Context {..} = do root <- buildRootRules let dir = root -/- contextDir context -- TODO: Get rid of hardcoded file paths. - dir -/- "setup-config" %> \_ -> do + dir -/- "setup-config" %> \_ -> configurePackage context -- TODO: Get rid of hardcoded file paths. @@ -37,53 +34,3 @@ buildPackageData context@Context {..} = do . replace "rts/dist/build" rtsPath . replace "includes/dist-derivedconstants/header" genPath ) . 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 = do - buildAdjustor <- anyTargetArch ["i386", "powerpc", "powerpc64"] - buildStgCRunAsm <- anyTargetArch ["powerpc64le"] - return $ [ "AdjustorAsm.S" | buildAdjustor ] - ++ [ "StgCRunAsm.S" | buildStgCRunAsm ] - | otherwise = return [] - -packageCmmSources :: Package -> Action [FilePath] -packageCmmSources pkg - | pkg == rts = do - rtsPath <- rtsBuildPath - sources <- getDirectoryFiles (pkgPath pkg) ["*.cmm"] - return $ sources ++ [ rtsPath -/- "cmm/AutoApply.cmm" ] - | pkg == base = do - sources <- getDirectoryFiles (pkgPath pkg) ["cbits/*.cmm"] - return sources - | otherwise = return [] diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index b2f901b0ec..c559748601 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -7,9 +7,7 @@ import Base import Context import Expression hiding (stage, way) import Oracles.ModuleFiles ---import Oracles.Setting import Oracles.Flag (crossCompiling) ---import Rules.Wrappers import Settings import Settings.Packages.Rts import Target @@ -49,7 +47,7 @@ buildProgram rs = do need =<< ghcDeps stage cross <- crossCompiling - -- for cross compiler. copy the stage0/bin/ + -- for cross compiler, copy the stage0/bin/ -- into stage1/bin/ case (package, cross, stage) of (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> do @@ -62,27 +60,6 @@ buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () buildBinary rs bin context@Context {..} = do binDeps <- if stage == Stage0 && package == ghcCabal then hsSources context - -- then do -- this is a hack, but he ghc-cabal packge only list's it's Main - -- -- it does however depend on the Lexer in lib:Cabal, and the - -- -- cbits file in libraries/text. - - -- -- it also depends on essnetially the content of all the following - -- -- libraries: Cabal/Cabal, binary, filepath, hpc, mtl, text, parsec - -- -- - -- -- We can not use the hsSource or other queries on those pacakges as - -- -- they require the package-data.mk, which in turn requires ghc-cabal. - -- -- - -- -- As such, we will ignore this for now, even though it will mean - -- -- that hadrian will not properly track the dependencies of - -- -- ghc-cabal properly. - - -- ghcCabalPath <- contextPath (context { Context.package = ghcCabal }) - -- cabalPath <- contextPath (context { Context.package = cabal }) - -- textPath <- contextPath (context { Context.package = text }) - -- return $ [ ghcCabalPath -/- "build" -/- "Main.o" - -- , cabalPath -/- "build" -/- "Cabal/Distribution/Parsec/Lexer.o" - -- , textPath -/- "build" -/- "c/cbits/cbits.o" - -- ] else do needLibrary =<< contextDependencies context when (stage > Stage0) $ do diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index fc9985ef67..887766651d 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -2,7 +2,6 @@ module Settings.Builders.Common ( module Base, module Expression, module Oracles.Flag, - module Oracles.PackageData, module Oracles.Setting, module Settings, module UserSettings, @@ -12,7 +11,6 @@ module Settings.Builders.Common ( import Base import Expression import Oracles.Flag -import Oracles.PackageData import Oracles.Setting import Settings import UserSettings From cdf1c4cc99c28ac448e7a2735f47845ded5c69cc Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 21:59:22 +0800 Subject: [PATCH 151/210] Drop Ghc Settings query. --- src/Builder.hs | 26 +++++++++++--------------- src/Builder.hs-boot | 2 +- src/Settings/Default.hs | 2 +- 3 files changed, 13 insertions(+), 17 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 7f5ac9dd7e..2be184f44f 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -48,7 +48,7 @@ instance NFData CcMode -- * Compile a C source file. -- * Extract source dependencies by passing @-M@ command line argument. -- * Link object files & static libraries into an executable. -data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs +data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs deriving (Eq, Generic, Show) instance Binary GhcMode @@ -64,7 +64,11 @@ instance Hashable GhcCabalMode instance NFData GhcCabalMode -- | GhcPkg can initialise a package database and register packages in it. -data GhcPkgMode = Init | Update | Clone | Dependencies 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 @@ -157,21 +161,13 @@ instance H.Builder Builder where Make dir -> need [dir -/- "Makefile"] _ -> when (isJust $ builderProvenance builder) $ need [path] - -- TODO: We would need to encode that asking a builder, - -- depending on the "ask" mode, has different return types. - -- For now it's the stdout string. - -- - -- This however means that the string -> datatype logic - -- needs to reside at the callsite. + -- 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 - Ghc Settings _ -> do - needBuilder builder - path <- H.builderPath builder - need [path] - Stdout stdout <- cmd [path] ["--info"] - return stdout - GhcPkg Dependencies _ -> do let input = fromSingleton msgIn buildInputs msgIn = "[askBuilder] Exactly one input file expected." diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index 074248d272..71dff1b5bd 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -7,7 +7,7 @@ import Hadrian.Builder.Tar import Development.Shake data CcMode = CompileC | FindCDependencies -data GhcMode = Settings | CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs +data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs data GhcCabalMode = Conf | Copy | Reg | HsColour | Check | Sdist data GhcPkgMode = Init | Update | Clone | Dependencies data HaddockMode = BuildPackage | BuildIndex diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index c80a6f1198..5f4c567554 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -50,7 +50,7 @@ data SourceArgs = SourceArgs sourceArgs :: SourceArgs -> Args sourceArgs SourceArgs {..} = builder Ghc ? mconcat [ hsDefault - , (not <$> builder (Ghc Settings)) ? getConfiguredCabalData ConfCabal.hcOpts + , getConfiguredCabalData ConfCabal.hcOpts , libraryPackage ? hsLibrary , package compiler ? hsCompiler , package ghc ? hsGhc ] From 9de3df30f438e991188ae913f602c8d952191873 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 22:20:26 +0800 Subject: [PATCH 152/210] Un-SMP --- src/Context.hs | 5 ----- src/Hadrian/Expression.hs | 6 +----- 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/src/Context.hs b/src/Context.hs index 2ab6f48066..4db7f0b1eb 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} module Context ( -- * Context Context (..), vanillaContext, stageContext, @@ -50,11 +49,7 @@ getStagedSettingList f = getSettingList . f =<< getStage -- | Construct an expression that depends on the current package having -- a Cabal file. For non haskell contexts it's empty. -#if !(MIN_VERSION_base(4,11,0)) withHsPackage :: (Monoid a, Semigroup a) => (Context -> Expr Context b a) -> Expr Context b a -#else -withHsPackage :: Monoid a => (Context -> Expr Context b a) -> Expr Context b a -#endif withHsPackage expr = do pkg <- getPackage ctx <- getContext diff --git a/src/Hadrian/Expression.hs b/src/Hadrian/Expression.hs index 7305ad908c..6d21847127 100644 --- a/src/Hadrian/Expression.hs +++ b/src/Hadrian/Expression.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, CPP #-} +{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-} module Hadrian.Expression ( -- * Expressions Expr, Predicate, Args, @@ -72,11 +72,7 @@ infixr 3 ? -- | Apply a predicate to an expression. -#if !(MIN_VERSION_base(4,11,0)) (?) :: (Monoid a, Semigroup a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a -#else -(?) :: (Monoid a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a -#endif p ? e = do bool <- toPredicate p if bool then e else mempty From 38a916386a62cdcac8b59c83c8246eae0fc9250d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 22:20:44 +0800 Subject: [PATCH 153/210] art*i*facts --- README.md | 2 +- src/Context/Paths.hs | 6 +++--- src/Hadrian/Builder.hs | 4 +++- src/Rules.hs | 12 ++++++++---- src/Rules/Library.hs | 2 +- src/Rules/Wrappers.hs | 2 +- 6 files changed, 17 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index d188a4a054..3fc6e94712 100644 --- a/README.md +++ b/README.md @@ -103,7 +103,7 @@ use `hadrian/UserSettings.hs` for the same purpose, see [documentation](doc/user #### Clean and full rebuild -* `build clean` removes all build artefacts. +* `build clean` removes all build artifacts. * `build -B` forces Shake to rerun all rules, even if the previous build results are are still up-to-date. diff --git a/src/Context/Paths.hs b/src/Context/Paths.hs index 274b27be15..327d2c7cdf 100644 --- a/src/Context/Paths.hs +++ b/src/Context/Paths.hs @@ -16,7 +16,7 @@ stagePath context = buildRoot <&> (-/- stageDir context) getStagePath :: Expr Context b FilePath getStagePath = expr . stagePath =<< getContext --- | The directory in 'buildRoot' containing build artefacts of a given 'Context'. +-- | The directory in 'buildRoot' containing build artifacts of a given 'Context'. contextDir :: Context -> FilePath contextDir Context {..} = stageString stage -/- pkgPath package @@ -27,11 +27,11 @@ contextPath context = buildRoot <&> (-/- contextDir context) getContextPath :: Expr Context b FilePath getContextPath = expr . contextPath =<< getContext --- | The directory in 'buildRoot' containing the object artefacts. +-- | The directory in 'buildRoot' containing the object artifacts. buildDir :: Context -> FilePath buildDir context = contextDir context -/- "build" --- | Path to the directory containing build artefacts of a given 'Context'. +-- | Path to the directory containing build artifacts of a given 'Context'. buildPath :: Context -> Action FilePath buildPath context = buildRoot <&> (-/- (buildDir context)) diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs index 2afde98440..bbd8747cf9 100644 --- a/src/Hadrian/Builder.hs +++ b/src/Hadrian/Builder.hs @@ -42,7 +42,9 @@ class ShakeValue b => Builder b where -- | The path to a builder. builderPath :: b -> Action FilePath - -- | Ask the builder for something + -- | 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 -- | Make sure a builder exists and rebuild it if out of date. diff --git a/src/Rules.hs b/src/Rules.hs index 3569c186a7..74fb27cad0 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -37,8 +37,8 @@ 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 bianries we want to - -- put into the bianry distribution. For now we will just *need* + -- 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"] version <- setting ProjectVersion @@ -69,7 +69,7 @@ topLevelTargets = do -- 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 @@ -116,7 +116,11 @@ packageRules = do Rules.Program.buildProgram readPackageDb forM_ [Stage0 .. ] $ \stage -> do - Rules.Register.registerPackages writePackageDb (Context stage base vanilla) -- base is only a dummy here. + -- 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 diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 5aed5e7af5..a2efc251de 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -23,7 +23,7 @@ archive :: Way -> String -> String archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") -- | Building a library consist of building --- the artefacts, and copying it somewhere +-- the artifacts, and copying it somewhere -- with cabal, and finally registering it -- with the compiler via cabal in the -- package database. diff --git a/src/Rules/Wrappers.hs b/src/Rules/Wrappers.hs index f1dfb7d4dd..8d70655cba 100644 --- a/src/Rules/Wrappers.hs +++ b/src/Rules/Wrappers.hs @@ -144,7 +144,7 @@ wrappersCommon = [ (vanillaContext Stage0 ghc , ghcWrapper) , (vanillaContext Stage2 haddock, haddockWrapper) , (vanillaContext Stage1 iservBin, iservBinWrapper) ] --- | List of wrappers for inplace artefacts +-- | List of wrappers for inplace artifacts inplaceWrappers :: [(Context, Wrapper)] inplaceWrappers = wrappersCommon ++ [ (vanillaContext Stage0 ghcPkg, inplaceGhcPkgWrapper) From e75827e9cc22642af52615c5cd59eb85ffc69625 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 22 Nov 2017 22:22:28 +0800 Subject: [PATCH 154/210] Cleanup --- src/Rules/Register.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 16547d4080..c08e6b2fa3 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -19,8 +19,6 @@ parseCabalName :: String -> Maybe (String, Version) parseCabalName = readPToMaybe parse where parse = (,) <$> (parsePackageName <* Parse.char '-') <*> parseOptVersion --- | This rule provides rules for copying packges into the --- boot packages db from the installed compiler. -- | Build rules for registering packages and initialising package databases -- by running the @ghc-pkg@ utility. registerPackages :: [(Resource, Int)] -> Context -> Rules () From ab0a1384ca10eeabdac1034f8a15314604bdfb90 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 24 Nov 2017 11:21:15 +0800 Subject: [PATCH 155/210] Handle system-ar supports @file. --- cfg/system.config.in | 2 ++ src/Builder.hs | 7 +++---- src/Oracles/Flag.hs | 5 +++-- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/cfg/system.config.in b/cfg/system.config.in index b007581330..2cde2d7eb4 100644 --- a/cfg/system.config.in +++ b/cfg/system.config.in @@ -35,6 +35,8 @@ cc-llvm-backend = @CC_LLVM_BACKEND@ gcc-is-clang = @GccIsClang@ hs-cpp-args = @HaskellCPPArgs@ +system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ + # Build options: #=============== diff --git a/src/Builder.hs b/src/Builder.hs index 2be184f44f..4b5a2a84a0 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -194,10 +194,9 @@ instance H.Builder Builder where Stdout stdout <- cmd [path] buildArgs writeFileChanged output stdout case builder of - Ar Pack _ -> do - useTempFile <- flag ArSupportsAtFile - if useTempFile then runAr path buildArgs - else runArWithoutTempFile path buildArgs + Ar Pack stage -> flag (ArSupportsAtFile stage) >>= \case + True -> runAr path buildArgs + False -> runArWithoutTempFile path buildArgs Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs diff --git a/src/Oracles/Flag.hs b/src/Oracles/Flag.hs index 1bd4dfeefd..0e7caaddc3 100644 --- a/src/Oracles/Flag.hs +++ b/src/Oracles/Flag.hs @@ -8,7 +8,7 @@ import Hadrian.Oracles.TextFile import Base import Oracles.Setting -data Flag = ArSupportsAtFile +data Flag = ArSupportsAtFile Stage | CrossCompiling | GccIsClang | GhcUnregisterised @@ -24,7 +24,8 @@ data Flag = ArSupportsAtFile flag :: Flag -> Action Bool flag f = do let key = case f of - ArSupportsAtFile -> "ar-supports-at-file" + ArSupportsAtFile Stage0 -> "system-ar-supports-at-file" + ArSupportsAtFile _ -> "ar-supports-at-file" CrossCompiling -> "cross-compiling" GccIsClang -> "gcc-is-clang" GhcUnregisterised -> "ghc-unregisterised" From c26cba3939baee788b6d1ad308a38c2d8545c77f Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 24 Nov 2017 12:07:49 +0800 Subject: [PATCH 156/210] More leaf nodes. --- hadrian.cabal | 1 + src/Hadrian/Builder/Ar.hs | 9 +-------- src/Hadrian/Builder/Sphinx.hs | 11 +---------- src/Hadrian/Builder/Tar.hs | 9 +-------- src/Hadrian/Builder/Types.hs | 27 +++++++++++++++++++++++++++ 5 files changed, 31 insertions(+), 26 deletions(-) create mode 100644 src/Hadrian/Builder/Types.hs diff --git a/hadrian.cabal b/hadrian.cabal index 1c419c3685..947dbf1be7 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -31,6 +31,7 @@ executable hadrian , Hadrian.Builder.Ar , Hadrian.Builder.Sphinx , Hadrian.Builder.Tar + , Hadrian.Builder.Types , Hadrian.Expression , Hadrian.Haskell.Cabal , Hadrian.Haskell.Cabal.Parse diff --git a/src/Hadrian/Builder/Ar.hs b/src/Hadrian/Builder/Ar.hs index ad74653db0..dd9b5efd15 100644 --- a/src/Hadrian/Builder/Ar.hs +++ b/src/Hadrian/Builder/Ar.hs @@ -20,17 +20,10 @@ module Hadrian.Builder.Ar (ArMode (..), args, runAr, runArWithoutTempFile) where import Control.Monad import Development.Shake -import Development.Shake.Classes -import GHC.Generics import Hadrian.Expression import Hadrian.Utilities --- | We support packing and unpacking archives with @ar@. -data ArMode = Pack | Unpack deriving (Eq, Generic, Show) - -instance Binary ArMode -instance Hashable ArMode -instance NFData ArMode +import Hadrian.Builder.Types (ArMode (..)) -- NOTE: Make sure to appropriately update 'arFlagsCount' when changing 'args'. -- | Default command line arguments for invoking the archiving utility @ar@. diff --git a/src/Hadrian/Builder/Sphinx.hs b/src/Hadrian/Builder/Sphinx.hs index 44b522c4d3..acf2287ac1 100644 --- a/src/Hadrian/Builder/Sphinx.hs +++ b/src/Hadrian/Builder/Sphinx.hs @@ -11,19 +11,10 @@ module Hadrian.Builder.Sphinx (SphinxMode (..), args) where import Development.Shake -import Development.Shake.Classes -import GHC.Generics import Hadrian.Expression import Hadrian.Utilities --- | Sphinx can be used in three different modes to convert reStructuredText --- documents into HTML, LaTeX or Man pages. -data SphinxMode = Html | Latex | Man deriving (Eq, Generic, Show) - -instance Binary SphinxMode -instance Hashable SphinxMode -instance NFData SphinxMode - +import Hadrian.Builder.Types (SphinxMode (..)) -- | Default command line arguments for invoking the archiving utility @tar@. args :: (ShakeValue c, ShakeValue b) => SphinxMode -> Args c b args mode = do diff --git a/src/Hadrian/Builder/Tar.hs b/src/Hadrian/Builder/Tar.hs index d51e3c7bee..0762abd5a4 100644 --- a/src/Hadrian/Builder/Tar.hs +++ b/src/Hadrian/Builder/Tar.hs @@ -11,16 +11,9 @@ module Hadrian.Builder.Tar (TarMode (..), args) where import Development.Shake -import Development.Shake.Classes -import GHC.Generics import Hadrian.Expression --- | Tar can be used to 'Create' an archive or 'Extract' from it. -data TarMode = Create | Extract deriving (Eq, Generic, Show) - -instance Binary TarMode -instance Hashable TarMode -instance NFData TarMode +import Hadrian.Builder.Types (TarMode (..)) -- | Default command line arguments for invoking the archiving utility @tar@. args :: (ShakeValue c, ShakeValue b) => TarMode -> Args c b diff --git a/src/Hadrian/Builder/Types.hs b/src/Hadrian/Builder/Types.hs new file mode 100644 index 0000000000..e8873a1e97 --- /dev/null +++ b/src/Hadrian/Builder/Types.hs @@ -0,0 +1,27 @@ +module Hadrian.Builder.Types where + +import GHC.Generics +import Development.Shake.Classes + +-- | We support packing and unpacking archives with @ar@. +data ArMode = Pack | Unpack deriving (Eq, Generic, Show) + +instance Binary ArMode +instance Hashable ArMode +instance NFData ArMode + +-- | Sphinx can be used in three different modes to convert reStructuredText +-- documents into HTML, LaTeX or Man pages. +data SphinxMode = Html | Latex | Man deriving (Eq, Generic, Show) + +instance Binary SphinxMode +instance Hashable SphinxMode +instance NFData SphinxMode + +-- | Tar can be used to 'Create' an archive or 'Extract' from it. +data TarMode = Create | Extract deriving (Eq, Generic, Show) + +instance Binary TarMode +instance Hashable TarMode +instance NFData TarMode + From 38d20e154786dae53d164b7085cc4f396b46d89b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 24 Nov 2017 12:08:01 +0800 Subject: [PATCH 157/210] Fix Ar Args. --- cfg/system.config.in | 13 ++++++++++++- src/Builder.hs-boot | 5 ++--- src/Hadrian/Builder/Ar.hs | 10 +++++++--- src/Oracles/Setting.hs | 10 +++++++--- src/Settings/Builders/HsCpp.hs | 2 +- 5 files changed, 29 insertions(+), 11 deletions(-) diff --git a/cfg/system.config.in b/cfg/system.config.in index 2cde2d7eb4..3f306902e7 100644 --- a/cfg/system.config.in +++ b/cfg/system.config.in @@ -18,6 +18,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-ld = @LD_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -33,7 +34,6 @@ ar-supports-at-file = @ArSupportsAtFile@ cc-clang-backend = @CC_CLANG_BACKEND@ cc-llvm-backend = @CC_LLVM_BACKEND@ gcc-is-clang = @GccIsClang@ -hs-cpp-args = @HaskellCPPArgs@ system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@ @@ -88,6 +88,15 @@ project-git-commit-id = @ProjectGitCommitId@ # Compilation and linking flags: #=============================== +# XXX: for most of the tools we have only up to +# stage2, as such building stage3 is +# is essentially impossible to do right now. + +conf-ar-args-stage0 = @AR_OPTS_STAGE0@ +conf-ar-args-stage1 = @ArArgs@ +conf-ar-args-stage2 = @ArArgs@ +conf-ar-args-stage3 = @ArArgs@ + conf-cc-args-stage0 = @CONF_CC_OPTS_STAGE0@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ @@ -104,6 +113,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/src/Builder.hs-boot b/src/Builder.hs-boot index 71dff1b5bd..2e5a29f06a 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -1,9 +1,7 @@ module Builder where import Stage -import Hadrian.Builder.Ar -import Hadrian.Builder.Sphinx -import Hadrian.Builder.Tar +import Hadrian.Builder.Types import Development.Shake data CcMode = CompileC | FindCDependencies @@ -40,5 +38,6 @@ data Builder = Alex | CabalFlags Stage instance Eq Builder +instance Show Builder builderPath' :: Builder -> Action FilePath diff --git a/src/Hadrian/Builder/Ar.hs b/src/Hadrian/Builder/Ar.hs index dd9b5efd15..9f517dbd65 100644 --- a/src/Hadrian/Builder/Ar.hs +++ b/src/Hadrian/Builder/Ar.hs @@ -20,15 +20,19 @@ module Hadrian.Builder.Ar (ArMode (..), args, runAr, runArWithoutTempFile) where import Control.Monad import Development.Shake -import Hadrian.Expression import Hadrian.Utilities +import Settings.Builders.Common +import Context (getStagedSettingList) +import Oracles.Setting ( SettingList ( ConfArArgs ) ) import Hadrian.Builder.Types (ArMode (..)) -- NOTE: Make sure to appropriately update 'arFlagsCount' when changing 'args'. -- | Default command line arguments for invoking the archiving utility @ar@. -args :: (ShakeValue c, ShakeValue b) => ArMode -> Args c b -args Pack = mconcat [ arg "q", arg =<< getOutput, getInputs ] +-- args :: (ShakeValue c, ShakeValue b) => SphinxMode -> Args c b +args :: ArMode -> Args +args Pack = mconcat [ getStagedSettingList ConfArArgs + , arg =<< getOutput, getInputs ] args Unpack = mconcat [ arg "x", arg =<< getInput ] -- This count includes "q" and the output file argumentes in 'args'. This is diff --git a/src/Oracles/Setting.hs b/src/Oracles/Setting.hs index aa49011e1e..f060a22da4 100644 --- a/src/Oracles/Setting.hs +++ b/src/Oracles/Setting.hs @@ -68,11 +68,12 @@ data Setting = BuildArch -- Command line for creating a symbolic link | LnS -data SettingList = ConfCcArgs Stage +data SettingList = ConfArArgs Stage + | ConfCcArgs Stage | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage - | HsCppArgs + | ConfHsCppArgs -- | Maps 'Setting's to names in @cfg/system.config.in@. setting :: Setting -> Action String @@ -124,13 +125,16 @@ setting key = lookupValueOrError configFile $ case key of InstallData -> "install-data" LnS -> "ln-s" +-- XXX: see cfg/system.config.in; most of these are only defined for stages +-- 0, 1, and 2. Stage 3 is missing. settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupValueOrError configFile $ case key of + ConfArArgs stage -> "conf-ar-args-" ++ stageString stage ConfCcArgs stage -> "conf-cc-args-" ++ stageString stage 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/Settings/Builders/HsCpp.hs b/src/Settings/Builders/HsCpp.hs index 7ad0cd3bd6..bb0e774e9f 100644 --- a/src/Settings/Builders/HsCpp.hs +++ b/src/Settings/Builders/HsCpp.hs @@ -9,7 +9,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 From 6f9a823137a10aca1d75f6d5c9f7a458def95860 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 24 Nov 2017 12:25:01 +0800 Subject: [PATCH 158/210] Staged LD --- src/Builder.hs | 5 +++-- src/Builder.hs-boot | 2 +- src/Rules/Libffi.hs | 2 +- src/Rules/Library.hs | 2 +- src/Settings/Builders/GhcCabal.hs | 4 ++-- 5 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 4b5a2a84a0..65e4e4272e 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -103,7 +103,7 @@ data Builder = Alex | Hpc | HsCpp | Hsc2Hs Stage - | Ld + | Ld Stage | Make FilePath | Nm | Objdump @@ -255,7 +255,8 @@ systemBuilderPath builder = case builder of GhcPkg _ Stage0 -> fromKey "system-ghc-pkg" Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" - Ld -> fromKey "ld" + Ld Stage0 -> fromKey "system-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 index 2e5a29f06a..143da285ad 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -24,7 +24,7 @@ data Builder = Alex | Hpc | HsCpp | Hsc2Hs Stage - | Ld + | Ld Stage | Make FilePath | Nm | Objdump diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index bda3a67820..55c7c3dab5 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -38,7 +38,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 diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index a2efc251de..248cef8fe4 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -115,7 +115,7 @@ buildPackageGhciLibrary context@Context {..} = priority 2 $ do 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 diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 125487b5d2..6301d0bcc1 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -36,7 +36,7 @@ ghcCabalBuilderArgs = mconcat , configureArgs , bootPackageConstraints , withStaged $ Cc CompileC - , notStage0 ? with Ld + , notStage0 ? with (Ld stage) , withStaged (Ar Pack) , with Alex , with Happy @@ -125,7 +125,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=" From b73601a991af867746b66527d70548d416455a59 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 24 Nov 2017 14:49:40 +0800 Subject: [PATCH 159/210] Disable stripping. --- src/Settings/Builders/GhcCabal.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 6301d0bcc1..5a7ea56750 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -20,6 +20,11 @@ ghcCabalBuilderArgs = mconcat path <- getContextPath stage <- getStage mconcat [ arg "configure" + -- 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" From ad87a29f562868bf385decaa746e79182d57be53 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 24 Nov 2017 21:53:20 +0800 Subject: [PATCH 160/210] Use target platform full! Otherwise platforms like `arm-linux-gnueabihf` will end up as `arm-unknown-linux` which is rather unfortunate. --- src/GHC.hs | 2 +- src/Rules.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 2409ad7828..72c461f0e4 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -105,7 +105,7 @@ stage2Packages = return [haddock] programName :: Context -> Action String programName Context {..} = do cross <- crossCompiling - targetPlatform <- setting TargetPlatform + targetPlatform <- setting TargetPlatformFull let prefix = if cross then targetPlatform ++ "-" else "" in return $ prefix ++ case package of p | p == ghc -> "ghc" diff --git a/src/Rules.hs b/src/Rules.hs index 74fb27cad0..c2080d5695 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -45,7 +45,7 @@ topLevelTargets = do cwd <- liftIO getCurrentDirectory binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" baseDir <- buildRoot <&> (-/- stageString Stage1) - targetPlatform <- setting TargetPlatform + targetPlatform <- setting TargetPlatformFull buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) From 00b692714b5114a2c0aaa3cecff072707f9c53e8 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 14:38:59 +0800 Subject: [PATCH 161/210] Arm SMP Archs. --- cfg/system.config.in | 1 + src/Oracles/Flag.hs | 6 +++++- src/Oracles/Setting.hs | 1 + 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/cfg/system.config.in b/cfg/system.config.in index 3f306902e7..7c1e534f49 100644 --- a/cfg/system.config.in +++ b/cfg/system.config.in @@ -62,6 +62,7 @@ host-vendor = @HostVendor_CPP@ target-platform = @TargetPlatform@ target-platform-full = @TargetPlatformFull@ target-arch = @TargetArch_CPP@ +target-arch-arm-isa = @ARM_ISA@ target-os = @TargetOS_CPP@ target-vendor = @TargetVendor_CPP@ llvm-target = @LLVMTarget_CPP@ diff --git a/src/Oracles/Flag.hs b/src/Oracles/Flag.hs index 0e7caaddc3..50334c1e6a 100644 --- a/src/Oracles/Flag.hs +++ b/src/Oracles/Flag.hs @@ -54,7 +54,11 @@ platformSupportsSharedLibs = do ghcWithSMP :: Action Bool ghcWithSMP = do - goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc", "arm"] + goodArch <- setting TargetArch >>= \case + -- arm is only good from v7 on wards. + "arm" -> not <$> matchSetting TargetArchArmISA ["ARMv5", "ARMv6"] + arch -> retrun $ arch `elem` ["i386", "x86_64", "sparc", "powerpc", "arm"] + ghcUnreg <- flag GhcUnregisterised return $ goodArch && not ghcUnreg diff --git a/src/Oracles/Setting.hs b/src/Oracles/Setting.hs index f060a22da4..1ba47e219b 100644 --- a/src/Oracles/Setting.hs +++ b/src/Oracles/Setting.hs @@ -102,6 +102,7 @@ setting key = lookupValueOrError configFile $ case key of ProjectPatchLevel1 -> "project-patch-level1" ProjectPatchLevel2 -> "project-patch-level2" TargetArch -> "target-arch" + TargetArchArmISA -> "target-arch-arm-isa" TargetOs -> "target-os" TargetPlatform -> "target-platform" TargetPlatformFull -> "target-platform-full" From cf8934ab62dd58afb8da18c762e6b2d591010799 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 15:41:32 +0800 Subject: [PATCH 162/210] WIP --- src/Settings/Flavours/QuickCrossNG.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index bcd4f79d5a..7fe386b992 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -12,6 +12,9 @@ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl :: Package dataBitcode = hsLib "data-bitcode" dataBitcodeLlvm = hsLib "data-bitcode-llvm" dataBitcodeEdsl = hsLib "data-bitcode-edsl" +network = hsLib "network" +libiserv = hsLib "libiserv" +iservProxy = hsUtil "iserv-proxy" llvmngWarningArgs :: Args llvmngWarningArgs = builder Ghc ? From 268696c282ceaa7093a8ab3fcf685f728ffaba07 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 20:14:09 +0800 Subject: [PATCH 163/210] fix compilation --- src/GHC/Packages.hs | 2 +- src/Oracles/Flag.hs | 2 +- src/Oracles/Setting.hs | 4 +++- src/Settings/Flavours/QuickCrossNG.hs | 15 ++++++++++++--- 4 files changed, 17 insertions(+), 6 deletions(-) diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 00211a7ac7..8549d34c49 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -59,7 +59,7 @@ hpc = hsLib "hpc" hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" integerGmp = hsLib "integer-gmp" integerSimple = hsLib "integer-simple" -iservBin = hsPrg "iserv-bin" `setPath` "iserv" +iservBin = hsUtil "iserv" libffi = cTop "libffi" mtl = hsLib "mtl" parsec = hsLib "parsec" diff --git a/src/Oracles/Flag.hs b/src/Oracles/Flag.hs index 50334c1e6a..c4d1994dca 100644 --- a/src/Oracles/Flag.hs +++ b/src/Oracles/Flag.hs @@ -57,7 +57,7 @@ ghcWithSMP = do goodArch <- setting TargetArch >>= \case -- arm is only good from v7 on wards. "arm" -> not <$> matchSetting TargetArchArmISA ["ARMv5", "ARMv6"] - arch -> retrun $ arch `elem` ["i386", "x86_64", "sparc", "powerpc", "arm"] + arch -> return $ arch `elem` ["i386", "x86_64", "sparc", "powerpc", "arm"] ghcUnreg <- flag GhcUnregisterised return $ goodArch && not ghcUnreg diff --git a/src/Oracles/Setting.hs b/src/Oracles/Setting.hs index 1ba47e219b..be6fe3a5b3 100644 --- a/src/Oracles/Setting.hs +++ b/src/Oracles/Setting.hs @@ -3,7 +3,8 @@ module Oracles.Setting ( getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs, ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors, ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost, - topDirectory, relocatableBuild, installDocDir, installGhcLibDir, libsuf + topDirectory, relocatableBuild, installDocDir, installGhcLibDir, libsuf, + matchSetting ) where import Hadrian.Expression @@ -42,6 +43,7 @@ data Setting = BuildArch | ProjectPatchLevel1 | ProjectPatchLevel2 | TargetArch + | TargetArchArmISA | TargetOs | TargetPlatform | TargetPlatformFull diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 7fe386b992..9ad48ae834 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -4,6 +4,7 @@ import Expression import Types.Flavour import {-# SOURCE #-} Settings.Default import GHC.Packages +import Oracles.Flag (crossCompiling) llvmngPackages :: [Package] llvmngPackages = [ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl ] @@ -12,10 +13,18 @@ dataBitcode, dataBitcodeLlvm, dataBitcodeEdsl :: Package dataBitcode = hsLib "data-bitcode" dataBitcodeLlvm = hsLib "data-bitcode-llvm" dataBitcodeEdsl = hsLib "data-bitcode-edsl" + +crossTHPackages :: [Package] +crossTHPackages = [ network, libiserv, iservProxy ] + +network, libiserv, iservProxy :: Package network = hsLib "network" libiserv = hsLib "libiserv" iservProxy = hsUtil "iserv-proxy" +crossTHPackageArgs :: Args +crossTHPackageArgs = builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv + llvmngWarningArgs :: Args llvmngWarningArgs = builder Ghc ? mconcat [ package dataBitcode ? pure [ "-Wno-name-shadowing" @@ -60,11 +69,11 @@ llvmngWarningArgs = builder Ghc ? quickCrossNGFlavour :: Flavour quickCrossNGFlavour = defaultFlavour { name = "quick-cross-ng" - , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs <> llvmngWarningArgs + , args = defaultBuilderArgs <> quickCrossNGArgs <> defaultPackageArgs <> llvmngWarningArgs <> crossTHPackageArgs , integerLibrary = pure integerSimple , libraryWays = pure [vanilla] - , extraPackages = llvmngPackages - , packages = fmap (++ llvmngPackages) . packages defaultFlavour + , extraPackages = llvmngPackages ++ crossTHPackages + , packages = fmap (++ (llvmngPackages ++ crossTHPackages)) . packages defaultFlavour } quickCrossNGArgs :: Args From 0f5c3ca0b95ed6504e54696e401b3df79f585bd2 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 20:52:07 +0800 Subject: [PATCH 164/210] Make sure we pass `-DNOSMP` to rts. This does it in a double fashion. We configure `rts` with `-smp`, which should cause cabal to expose the cpp arg to `-DNOSMP`, but for good measure add it explicitly as well. Eventually we should migrate all those flags into the `.cabal` file. However the way dependent flags are going to be challenging as cabal has no concept of building `ways` of a library. --- src/Settings/Packages/Rts.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index a6fe39736e..da58ea7013 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -123,6 +123,7 @@ rtsPackageArgs = package rts ? do , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY" , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" + , notM ghcWithSMP ? arg "-DNOSMP" , inputs ["//RtsMessages.c", "//Trace.c"] ? arg ("-DProjectVersion=" ++ show projectVersion) @@ -186,6 +187,7 @@ rtsPackageArgs = package rts ? do mconcat [ builder (Cc FindCDependencies) ? cArgs + , builder CabalFlags ? not <$> ghcWithSMP ? arg "-smp" , builder (Ghc CompileCWithGhc) ? map ("-optc" ++) <$> cArgs , builder Ghc ? arg "-Irts" From 987c77c3b901c31f85b0f2c9d21adb91e1c48067 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 23:14:44 +0800 Subject: [PATCH 165/210] Make sure we actually read the `.buildinfo` files for ConfiguredCabal as well. Nasty bug. Ideally this should be an opaque API from cabal. ``` getLocalBuildInfo :: FilePath -> LocalBuildInfo ``` configure the package if needed, and return the lbi, including the updated package description (if needed). --- src/Hadrian/Haskell/Cabal/Parse.hs | 82 ++++++++++++++++++------------ 1 file changed, 49 insertions(+), 33 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 29a7528a96..46200809dd 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -37,6 +37,7 @@ import qualified Distribution.Simple.Program.Db as Db import qualified Distribution.Simple as Hooks (simpleUserHooks, autoconfUserHooks) 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) @@ -213,23 +214,26 @@ parseConfiguredCabal context@Context {..} = do -- 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). - liftIO $ C.initialBuildSteps cPath pd lbi C.silent + 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 + let extDeps = C.externalPackageDeps lbi' deps = map (display . snd) extDeps dep_direct = map (fromMaybe (error "dep_keys failed") - . PackageIndex.lookupUnitId (C.installedPkgs lbi) + . PackageIndex.lookupUnitId (C.installedPkgs lbi') . fst) extDeps dep_ipids = map (display . Installed.installedUnitId) dep_direct - Just ghcProg = Db.lookupProgram C.ghcProgram (C.withPrograms lbi) + Just ghcProg = Db.lookupProgram C.ghcProgram (C.withPrograms lbi') - dep_pkgs = PackageIndex.topologicalOrder (packageHacks (C.installedPkgs lbi)) + dep_pkgs = PackageIndex.topologicalOrder (packageHacks (C.installedPkgs lbi')) forDeps f = concatMap f dep_pkgs -- copied from Distribution.Simple.PreProcess.ppHsc2Hs - packageHacks = case compilerFlavor (C.compiler lbi) of - GHC | C.pkgName (C.package pd) /= (C.mkPackageName "rts") -> hackRtsPackage + packageHacks = case compilerFlavor (C.compiler lbi') of + 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 @@ -254,41 +258,53 @@ parseConfiguredCabal context@Context {..} = do in return $ ConfiguredCabal { dependencies = deps - , name = C.unPackageName . C.pkgName . C.package $ pd - , version = C.display . C.pkgVersion . C.package $ pd + , 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 - , srcDirs = C.hsSourceDirs . fst . biModules $ 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' + , 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) + , 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 + , 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 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.hcOptions 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 + , 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 + , 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 + From 7272bcbd3fa34c6d8a443ea030746492ead9e645 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 23:15:17 +0800 Subject: [PATCH 166/210] Adds ccOpts to hsc2hs. This is necessary for example if we try to compile `network`. --- src/Settings/Builders/Hsc2Hs.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index c128c9f81c..6467635603 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -44,6 +44,8 @@ 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 , cWarnings From 4ae7d9a42a3e455158f32e2b1ebaef34812250f0 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 23:30:51 +0800 Subject: [PATCH 167/210] Disable overflowed-literals in network. See https://github.com/haskell/network/issues/258 --- src/Settings/Flavours/QuickCrossNG.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 9ad48ae834..ca2473cc7e 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -23,7 +23,9 @@ libiserv = hsLib "libiserv" iservProxy = hsUtil "iserv-proxy" crossTHPackageArgs :: Args -crossTHPackageArgs = builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv +crossTHPackageArgs = mconcat + [ builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv + , builder Ghc ? package network ? pure ["-Wno-overflowed-literals"] ] llvmngWarningArgs :: Args llvmngWarningArgs = builder Ghc ? From 858ffed7b77f9cf8fad6b54e6c577fcbc78eb68c Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 23:41:24 +0800 Subject: [PATCH 168/210] Use flavour args, isntead of defaultArgs only. --- src/Hadrian/Haskell/Cabal/Parse.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 46200809dd..54ba047b12 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -56,11 +56,11 @@ import Hadrian.Expression import Hadrian.Target import Types.Cabal ( Cabal( Cabal ) ) import Types.ConfiguredCabal +import Types.Flavour (args) import Settings import Oracles.Setting -import Settings.Default import Context import Hadrian.Oracles.TextFile @@ -104,7 +104,7 @@ parseCabal context@Context {..} = do (compiler, Just platform, _pgdb) <- liftIO $ GHC.configure C.silent (Just hcPath) Nothing Db.emptyProgramDb - flagList <- interpret (target context (CabalFlags stage) [] []) defaultPackageArgs + 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 @@ -157,10 +157,10 @@ configurePackage context@Context {..} = do case pkgCabalFile package of Nothing -> error "No a cabal package!" Just _ -> do - -- compute the flaglist over the defaultPackageArgs - flagList <- interpret (target context (CabalFlags stage) [] []) defaultPackageArgs - -- compute the cabal conf args over all the default args - argList <- interpret (target context (GhcCabal Conf stage) [] []) defaultArgs + -- 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 defaultMainWithHooksNoReadArgs hooks gpd (argList ++ ["--flags=" ++ unwords flagList]) From f38d55f8292dcc76754c776bc9e6419f1575f6cc Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sat, 25 Nov 2017 23:43:41 +0800 Subject: [PATCH 169/210] libiserv has an incomplete pattern match. --- src/Settings/Flavours/QuickCrossNG.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index ca2473cc7e..f4c8731264 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -25,7 +25,9 @@ iservProxy = hsUtil "iserv-proxy" crossTHPackageArgs :: Args crossTHPackageArgs = mconcat [ builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv - , builder Ghc ? package network ? pure ["-Wno-overflowed-literals"] ] + , builder Ghc ? package network ? pure ["-Wno-overflowed-literals"] + , builder Ghc ? package libiserv ? pure ["-Wno-incomplete-patterns"] + ] llvmngWarningArgs :: Args llvmngWarningArgs = builder Ghc ? From e027f8faa2a9e22d6cc0e76e9840e15d999c2487 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 26 Nov 2017 10:31:50 +0800 Subject: [PATCH 170/210] No unused import warnings for libiserv and iservProxy --- src/Settings/Flavours/QuickCrossNG.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index f4c8731264..01ae6503ec 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -26,7 +26,8 @@ crossTHPackageArgs :: Args crossTHPackageArgs = mconcat [ builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv , builder Ghc ? package network ? pure ["-Wno-overflowed-literals"] - , builder Ghc ? package libiserv ? pure ["-Wno-incomplete-patterns"] + , builder Ghc ? package libiserv ? pure ["-Wno-incomplete-patterns", "-Wno-unused-imports"] + , builder Ghc ? package iservProxy ? pure ["-Wno-unused-imports"] ] llvmngWarningArgs :: Args From c6ffd661926673f9c1fe15d1125faa17a06342ee Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 26 Nov 2017 10:32:22 +0800 Subject: [PATCH 171/210] For cross compilers all stage2 programs are stage1 programs We can't run the stage2 programs on the build system anyway. --- src/Rules/Program.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index c559748601..036d45f9af 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -49,10 +49,10 @@ buildProgram rs = do cross <- crossCompiling -- for cross compiler, copy the stage0/bin/ -- into stage1/bin/ - case (package, cross, stage) of - (p, True, s) | s > Stage0 && p `elem` [ghc, ghcPkg, hsc2hs] -> do - srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin")) - copyFile (srcDir -/- takeFileName bin) 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' From bef861d0f1006ff44898b9b97de8147a8c0930fe Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 26 Nov 2017 16:48:10 +0800 Subject: [PATCH 172/210] No `--cross-safe` for crossCompiling In general we migth want to consider dropping this altogether. hsc2hs apparently does *not* preprocess the file via the `cc` and the `clfags`. As such anything that's within `#ifdef`s that is not cross-safe, even though it's not relevant to the current compilation triggers cross-safe. --- src/Settings/Builders/Hsc2Hs.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 6467635603..3613850b0d 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -22,7 +22,7 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do 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 From acb09551cc0139834e7f659ca723b6b14b4e3406 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 26 Nov 2017 16:48:40 +0800 Subject: [PATCH 173/210] Build -fghci ghci in stage0 for cross compilers. This *does* require to bootstrap with the same compiler. --- src/Settings/Packages.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index a2a7297045..7d1600ee75 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -90,7 +90,19 @@ packageArgs = do , 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" From 09a801b0a2ce7f526e924acb27003ffb73b41100 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 26 Nov 2017 17:07:23 +0800 Subject: [PATCH 174/210] cleanup --- src/Rules.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Rules.hs b/src/Rules.hs index c2080d5695..434b833291 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -54,8 +54,14 @@ 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] + targets <- mapM (f Stage1) =<< stagePackages Stage1 - liftIO . putStrLn . unlines $ map ("- " ++) targets need targets where -- either the package databae config file for libraries or @@ -65,6 +71,9 @@ topLevelTargets = do 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'. From bbed8e3a33e50414242ca1a514005b20d804b02b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 26 Nov 2017 17:07:35 +0800 Subject: [PATCH 175/210] Be more selective about when to build, which tool. --- src/GHC.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/GHC.hs b/src/GHC.hs index 72c461f0e4..2b959b38dd 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -66,6 +66,7 @@ stage1Packages = do win <- windowsHost intLib <- integerLibrary =<< flavour libraries0 <- filter isLibrary <$> stage0Packages + cross <- crossCompiling return $ libraries0 -- Build all Stage0 libraries in Stage1 ++ [ array , base @@ -79,21 +80,21 @@ stage1Packages = do , ghcPkg , ghcPrim , haskeline - , hpcBin , hsc2hs , intLib , pretty , process , rts - , runGhc , stm , time , unlit - , xhtml - , haddock ] - ++ [ iservBin | not win ] - ++ [ unix | not win ] - ++ [ win32 | win ] + , xhtml ] + ++ [ haddock | not cross ] + ++ [ runGhc | not cross ] + ++ [ hpcBin | not cross ] + ++ [ iservBin | not win, not cross ] + ++ [ unix | not win ] + ++ [ win32 | win ] stage2Packages :: Action [Package] stage2Packages = return [haddock] From d1e55017806223a82b5cee11c31d5e68cd7f94de Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 1 Dec 2017 21:11:03 +0800 Subject: [PATCH 176/210] fast-llvm --- src/Settings/Flavours/QuickCrossNG.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 01ae6503ec..71a7b70c9b 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -84,8 +84,8 @@ quickCrossNGFlavour = defaultFlavour quickCrossNGArgs :: Args quickCrossNGArgs = sourceArgs SourceArgs { hsDefault = pure ["-O0", "-H64m"] - , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvmng" ] + , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvmng", arg "-fast-llvm" ] , hsCompiler = stage0 ? arg "-O" , hsGhc = mconcat [ stage0 ? arg "-O" - , stage1 ? mconcat [ arg "-O0", arg "-fllvmng" ] ] } + , stage1 ? mconcat [ arg "-O0", arg "-fllvmng", arg "-fast-llvm" ] ] } From 4c3cf61fe93349c7c49c345c219c5338db4d8bb4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 10:08:52 +0800 Subject: [PATCH 177/210] Add libiserv to QuickWithNG --- src/Settings/Flavours/QuickWithNG.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Settings/Flavours/QuickWithNG.hs b/src/Settings/Flavours/QuickWithNG.hs index 3f187f6c3d..528573e586 100644 --- a/src/Settings/Flavours/QuickWithNG.hs +++ b/src/Settings/Flavours/QuickWithNG.hs @@ -13,6 +13,8 @@ dataBitcode = hsLib "data-bitcode" dataBitcodeLlvm = hsLib "data-bitcode-llvm" dataBitcodeEdsl = hsLib "data-bitcode-edsl" +libiserv = hsLib "libiserv" + llvmngWarningArgs :: Args llvmngWarningArgs = builder Ghc ? mconcat [ package dataBitcode ? pure [ "-Wno-name-shadowing" @@ -63,7 +65,7 @@ quickWithNGFlavour = defaultFlavour -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] , extraPackages = llvmngPackages - , packages = fmap (++ llvmngPackages) . packages defaultFlavour + , packages = fmap (++ libiserv:llvmngPackages) . packages defaultFlavour } quickWithNGArgs :: Args From 940822b18353d09349ee44d3205cb24a1edb8d4b Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 10:10:56 +0800 Subject: [PATCH 178/210] Add type annotation. --- src/Settings/Flavours/QuickWithNG.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Settings/Flavours/QuickWithNG.hs b/src/Settings/Flavours/QuickWithNG.hs index 528573e586..6402112912 100644 --- a/src/Settings/Flavours/QuickWithNG.hs +++ b/src/Settings/Flavours/QuickWithNG.hs @@ -13,6 +13,7 @@ dataBitcode = hsLib "data-bitcode" dataBitcodeLlvm = hsLib "data-bitcode-llvm" dataBitcodeEdsl = hsLib "data-bitcode-edsl" +libiserv :: Package libiserv = hsLib "libiserv" llvmngWarningArgs :: Args From 5cdc9fb10125d658e7216f10e06d42c8de3f3d94 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 14:29:42 +0800 Subject: [PATCH 179/210] Adds includes to FindCDependencies --- src/Settings/Builders/Cc.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index eeffec6b13..fc467974f1 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -7,6 +7,9 @@ import Builder () ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay + iconvIncludeDir <- getSetting IconvIncludeDir + gmpIncludeDir <- getSetting GmpIncludeDir + ffiIncludeDir <- getSetting FfiIncludeDir builder Cc ? mconcat [ getConfiguredCabalData ConfCabal.ccOpts , getStagedSettingList ConfCcArgs @@ -24,5 +27,7 @@ ccBuilderArgs = do , arg "-MM", arg "-MG" , arg "-MF", arg output , arg "-MT", arg $ dropExtension output -<.> "o" + , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] + , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir) , arg "-x", arg "c" , arg =<< getInput ] ] From 0d20aa05b80e6981760e29f886cf1fad12a29042 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 15:37:16 +0800 Subject: [PATCH 180/210] better include logic. --- src/Settings/Builders/Cc.hs | 8 ++------ src/Settings/Builders/Common.hs | 5 +++++ 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index fc467974f1..5d0621496f 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -7,16 +7,13 @@ import Builder () ccBuilderArgs :: Args ccBuilderArgs = do way <- getWay - iconvIncludeDir <- getSetting IconvIncludeDir - gmpIncludeDir <- getSetting GmpIncludeDir - ffiIncludeDir <- getSetting FfiIncludeDir builder Cc ? mconcat [ getConfiguredCabalData ConfCabal.ccOpts , getStagedSettingList ConfCcArgs - , cIncludeArgs , builder (Cc CompileC) ? mconcat [ pure ["-Wall", "-Werror"] + , cIncludeArgs , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] , arg "-c", arg =<< getInput , arg "-o", arg =<< getOutput ] @@ -27,7 +24,6 @@ ccBuilderArgs = do , arg "-MM", arg "-MG" , arg "-MF", arg output , arg "-MT", arg $ dropExtension output -<.> "o" - , pure . map ("-I"++) . filter (/= "") $ [iconvIncludeDir, gmpIncludeDir] - , flag UseSystemFfi ? arg ("-I" ++ ffiIncludeDir) + , cIncludeArgs , arg "-x", arg "c" , arg =<< getInput ] ] diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 887766651d..e882abdb4f 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -25,11 +25,16 @@ cIncludeArgs = do path <- getBuildPath 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) , pure [ "-I" ++ pkgPath pkg -/- dir | dir <- incDirs ] , pure [ "-I" ++ unifyPath dir | dir <- depDirs ] ] From d403356f6c447fc0c672a98fec77d87ef3736512 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 16:00:01 +0800 Subject: [PATCH 181/210] No fail --- src/Settings/Warnings.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index a4783afa5d..dd253318f0 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -29,7 +29,9 @@ warningArgs = builder Ghc ? do , "-fno-warn-unused-imports" ] ] , notStage0 ? mconcat [ libraryPackage ? pure [ "-Wno-deprecated-flags" ] - , package base ? pure [ "-Wno-trustworthy-safe" ] + , package base ? pure [ "-Wno-trustworthy-safe" + , "-Wno-unused-top-binds" -- this fails on android for libraries/base/GHC/Event/Poll.hsc + ] , package binary ? pure [ "-Wno-deprecations" ] , package bytestring ? pure [ "-Wno-inline-rule-shadowing" ] , package compiler ? pure [ "-Wcpp-undef" ] From 6de8bcc0819338e5207ce46cf43df483ed6577f2 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 16:14:13 +0800 Subject: [PATCH 182/210] unbreak unix. --- src/Settings/Warnings.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index dd253318f0..2b5ad1dc49 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -56,5 +56,6 @@ warningArgs = builder Ghc ? do , "-Wno-redundant-constraints" , "-Wno-orphans" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] - , package xhtml ? pure [ "-Wno-unused-imports" ] ] + , package xhtml ? pure [ "-Wno-unused-imports" ] + , package unix ? pure [ "-Wno-incomplete-patterns"] ] ] From d1faf55a4bbc5b138e80308299606ad44d565120 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 4 Dec 2017 16:19:29 +0800 Subject: [PATCH 183/210] More unix fixes --- src/Settings/Warnings.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index 2b5ad1dc49..5fbfeffac6 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -57,5 +57,6 @@ warningArgs = builder Ghc ? do , "-Wno-orphans" ] , package win32 ? pure [ "-Wno-trustworthy-safe" ] , package xhtml ? pure [ "-Wno-unused-imports" ] - , package unix ? pure [ "-Wno-incomplete-patterns"] ] + , package unix ? pure [ "-Wno-incomplete-patterns" + , "-Wno-unused-top-binds" ] ] ] From 70bbb7727ab84677ac9ad1b4f468c6d284acecb0 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Fri, 1 Dec 2017 15:37:31 +0100 Subject: [PATCH 184/210] wip bindist configure script with hadrian --- shell.nix | 4 +++- src/Builder.hs | 16 ++++++++++++---- src/Builder.hs-boot | 1 + src/Rules.hs | 9 ++++++++- src/Rules/Register.hs | 1 + 5 files changed, 25 insertions(+), 6 deletions(-) diff --git a/shell.nix b/shell.nix index e9a5ecc88e..ce4d6961bc 100644 --- a/shell.nix +++ b/shell.nix @@ -57,5 +57,7 @@ in nixpkgs.ncurses nixpkgs.m4 nixpkgs.gmp - nixpkgs.file ]; + nixpkgs.file + nixpkgs.llvm_5 + ]; } diff --git a/src/Builder.hs b/src/Builder.hs index 65e4e4272e..26291d5f76 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -90,6 +90,7 @@ instance NFData HaddockMode -- @GhcPkg Stage1@ is the one built in Stage0. data Builder = Alex | Ar ArMode Stage + | Autoreconf FilePath | DeriveConstants | Cc CcMode Stage | Configure FilePath @@ -156,10 +157,11 @@ instance H.Builder Builder where needBuilder builder = do path <- H.builderPath builder case builder of - Configure dir -> need [dir -/- "configure"] - Hsc2Hs stage -> templateHscPath stage >>= \tmpl -> need [path, tmpl] - Make dir -> need [dir -/- "Makefile"] - _ -> when (isJust $ builderProvenance builder) $ need [path] + Autoreconf dir -> need [dir -/- "configure.ac"] + Configure dir -> need [dir -/- "configure"] + Hsc2Hs stage -> templateHscPath stage >>= \tmpl -> need [path, tmpl] + Make dir -> need [dir -/- "Makefile"] + _ -> when (isJust $ builderProvenance builder) $ need [path] -- query the builder for some information. -- contrast this with runBuilderWith, which returns @Action ()@ @@ -200,6 +202,11 @@ instance H.Builder Builder where Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs + Autoreconf dir -> do + bash <- bashPath + let env = AddEnv "CONFIG_SHELL" bash + cmd echo env [Cwd dir] ["sh", path] buildOptions buildArgs + Configure dir -> do -- Inject /bin/bash into `libtool`, instead of /bin/sh, -- otherwise Windows breaks. TODO: Figure out why. @@ -247,6 +254,7 @@ systemBuilderPath builder = case builder of Alex -> fromKey "alex" Ar _ Stage0 -> fromKey "system-ar" Ar _ _ -> fromKey "ar" + Autoreconf _ -> fromKey "autoreconf" Cc _ Stage0 -> fromKey "system-cc" Cc _ _ -> fromKey "cc" -- We can't ask configure for the path to configure! diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot index 143da285ad..c619ff4f19 100644 --- a/src/Builder.hs-boot +++ b/src/Builder.hs-boot @@ -11,6 +11,7 @@ data GhcPkgMode = Init | Update | Clone | Dependencies data HaddockMode = BuildPackage | BuildIndex data Builder = Alex | Ar ArMode Stage + | Autoreconf FilePath | DeriveConstants | Cc CcMode Stage | Configure FilePath diff --git a/src/Rules.hs b/src/Rules.hs index 434b833291..e51a068ec5 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -46,10 +46,17 @@ topLevelTargets = do 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") [] [] + copyFile (cwd -/- "distrib" -/- "configure") (baseDir -/- "configure") + buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) - ["bin", "lib"] + ["bin", "lib", "configure"] [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] phony "stage2" $ do diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index c08e6b2fa3..f34e5cef67 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -83,6 +83,7 @@ buildConf _ context@Context {..} _conf = do , bldPath -/- "ghcautoconf.h" , bldPath -/- "ghcplatform.h" , bldPath -/- "ghcversion.h" + , bldPath -/- "ffi.h" ] when (package == integerGmp) $ From b9cef84c84f2fb64f76230e0b6ba207294049bea Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 4 Dec 2017 14:51:19 +0100 Subject: [PATCH 185/210] ship root Makefile into bindist archive --- src/Rules.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Rules.hs b/src/Rules.hs index e51a068ec5..4409ccbc48 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -53,10 +53,13 @@ topLevelTargets = do target (vanillaContext Stage1 ghc) (Autoreconf $ cwd -/- "distrib") [] [] copyFile (cwd -/- "distrib" -/- "configure") (baseDir -/- "configure") + -- copy the Makefile from the source of the tree to the bindist dir + copyFile (cwd -/- "Makefile") (baseDir -/- "Makefile") + buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) - ["bin", "lib", "configure"] + ["bin", "lib", "configure", "Makefile"] [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] phony "stage2" $ do From 4983bd68c0b5c22ad65c3d9df3c5845cc753d732 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 4 Dec 2017 23:15:27 +0100 Subject: [PATCH 186/210] wip binary dist configure/Makefile --- src/Builder.hs | 2 +- src/Rules.hs | 16 ++++++++++++++-- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 26291d5f76..43dd539217 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -254,7 +254,7 @@ systemBuilderPath builder = case builder of Alex -> fromKey "alex" Ar _ Stage0 -> fromKey "system-ar" Ar _ _ -> fromKey "ar" - Autoreconf _ -> fromKey "autoreconf" + Autoreconf _ -> return "autoreconf" Cc _ Stage0 -> fromKey "system-cc" Cc _ _ -> fromKey "cc" -- We can't ask configure for the path to configure! diff --git a/src/Rules.hs b/src/Rules.hs index 4409ccbc48..5893988f03 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -53,13 +53,25 @@ topLevelTargets = do target (vanillaContext Stage1 ghc) (Autoreconf $ cwd -/- "distrib") [] [] copyFile (cwd -/- "distrib" -/- "configure") (baseDir -/- "configure") - -- copy the Makefile from the source of the tree to the bindist dir + -- copy config.sub, config.guess, install-sh, Makefile files, etc + -- from the source of the tree to the bindist dir copyFile (cwd -/- "Makefile") (baseDir -/- "Makefile") + copyFile (cwd -/- "install-sh") (baseDir -/- "install-sh") + copyFile (cwd -/- "config.sub") (baseDir -/- "config.sub") + copyFile (cwd -/- "config.guess") (baseDir -/- "config.guess") + copyFile (cwd -/- "settings.in") (baseDir -/- "settings.in") + copyFile (cwd -/- "mk" -/- "config.mk.in") (baseDir -/- "mk" -/- "config.mk.in") + copyFile (cwd -/- "mk" -/- "install.mk.in") (baseDir -/- "mk" -/- "install.mk.in") + copyFile (cwd -/- "mk" -/- "custom-settings.mk") (baseDir -/- "mk" -/- "custom-settings.mk") + copyFile (cwd -/- "mk" -/- "project.mk") (baseDir -/- "mk" -/- "project.mk") buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) - ["bin", "lib", "configure", "Makefile"] + [ "bin", "lib", "configure", "config.sub", "config.guess" + , "Makefile", "install-sh", "settings.in", "mk/config.mk.in" + , "mk/install.mk.in", "mk/project.mk", "mk/custom-settings.mk" + ] [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] phony "stage2" $ do From ef6f26cbd27ce1696eeb8f08ed3c093b9cbe2872 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 5 Dec 2017 07:55:37 +0800 Subject: [PATCH 187/210] meh. -Werror hits again. --- src/Settings/Flavours/QuickCrossNG.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 71a7b70c9b..e8192114e6 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -25,7 +25,9 @@ iservProxy = hsUtil "iserv-proxy" crossTHPackageArgs :: Args crossTHPackageArgs = mconcat [ builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv - , builder Ghc ? package network ? pure ["-Wno-overflowed-literals"] + , builder Ghc ? package network ? pure [ "-Wno-overflowed-literals" + , "-Wno-incomplete-patterns" -- gets triggered by the iOS build + ] , builder Ghc ? package libiserv ? pure ["-Wno-incomplete-patterns", "-Wno-unused-imports"] , builder Ghc ? package iservProxy ? pure ["-Wno-unused-imports"] ] From 1a6d1f98dbbbd3bae9cd76f6e5042a82a0687b82 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 5 Dec 2017 09:14:05 +0800 Subject: [PATCH 188/210] -Werror again --- src/Settings/Flavours/QuickCrossNG.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index e8192114e6..c7fe846ac0 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -27,6 +27,7 @@ crossTHPackageArgs = mconcat [ builder CabalFlags ? package libiserv ? crossCompiling ? arg "network" -- apply -fnetwork to libiserv , builder Ghc ? package network ? pure [ "-Wno-overflowed-literals" , "-Wno-incomplete-patterns" -- gets triggered by the iOS build + , "-Wno-unused-imports" -- also triggered by the iOS build ] , builder Ghc ? package libiserv ? pure ["-Wno-incomplete-patterns", "-Wno-unused-imports"] , builder Ghc ? package iservProxy ? pure ["-Wno-unused-imports"] From 8a9d800b39d18a84431e5224106f766d5f8b8527 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 5 Dec 2017 11:39:18 +0100 Subject: [PATCH 189/210] leave out the most I can while still having ./configure work --- src/Rules.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 5893988f03..f6cb4fe394 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -55,22 +55,23 @@ topLevelTargets = do -- copy config.sub, config.guess, install-sh, Makefile files, etc -- from the source of the tree to the bindist dir - copyFile (cwd -/- "Makefile") (baseDir -/- "Makefile") + -- copyFile (cwd -/- "Makefile") (baseDir -/- "Makefile") copyFile (cwd -/- "install-sh") (baseDir -/- "install-sh") copyFile (cwd -/- "config.sub") (baseDir -/- "config.sub") copyFile (cwd -/- "config.guess") (baseDir -/- "config.guess") copyFile (cwd -/- "settings.in") (baseDir -/- "settings.in") copyFile (cwd -/- "mk" -/- "config.mk.in") (baseDir -/- "mk" -/- "config.mk.in") copyFile (cwd -/- "mk" -/- "install.mk.in") (baseDir -/- "mk" -/- "install.mk.in") - copyFile (cwd -/- "mk" -/- "custom-settings.mk") (baseDir -/- "mk" -/- "custom-settings.mk") - copyFile (cwd -/- "mk" -/- "project.mk") (baseDir -/- "mk" -/- "project.mk") + -- copyFile (cwd -/- "mk" -/- "custom-settings.mk") (baseDir -/- "mk" -/- "custom-settings.mk") + -- copyFile (cwd -/- "mk" -/- "project.mk") (baseDir -/- "mk" -/- "project.mk") buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) [ "bin", "lib", "configure", "config.sub", "config.guess" - , "Makefile", "install-sh", "settings.in", "mk/config.mk.in" - , "mk/install.mk.in", "mk/project.mk", "mk/custom-settings.mk" + , "install-sh", "settings.in", "mk/config.mk.in", "mk/install.mk.in" + -- , "Makefile", "mk/project.mk", "mk/custom-settings.mk" + -- , "ghc.mk" ] [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] From c6836fa176585266b80f27159ae237c0e205576c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 5 Dec 2017 14:55:21 +0100 Subject: [PATCH 190/210] ship a minimal custom Makefile in hadrian bindists --- src/Rules.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index f6cb4fe394..9b16850308 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -51,27 +51,24 @@ topLevelTargets = do copyFile (cwd -/- "aclocal.m4") (cwd -/- "distrib" -/- "aclocal.m4") buildWithCmdOptions [Cwd $ cwd -/- "distrib"] $ target (vanillaContext Stage1 ghc) (Autoreconf $ cwd -/- "distrib") [] [] - copyFile (cwd -/- "distrib" -/- "configure") (baseDir -/- "configure") -- copy config.sub, config.guess, install-sh, Makefile files, etc -- from the source of the tree to the bindist dir - -- copyFile (cwd -/- "Makefile") (baseDir -/- "Makefile") + copyFile (cwd -/- "distrib" -/- "configure") (baseDir -/- "configure") + copyFile (cwd -/- "distrib" -/- "Makefile") (baseDir -/- "Makefile") copyFile (cwd -/- "install-sh") (baseDir -/- "install-sh") copyFile (cwd -/- "config.sub") (baseDir -/- "config.sub") copyFile (cwd -/- "config.guess") (baseDir -/- "config.guess") copyFile (cwd -/- "settings.in") (baseDir -/- "settings.in") copyFile (cwd -/- "mk" -/- "config.mk.in") (baseDir -/- "mk" -/- "config.mk.in") copyFile (cwd -/- "mk" -/- "install.mk.in") (baseDir -/- "mk" -/- "install.mk.in") - -- copyFile (cwd -/- "mk" -/- "custom-settings.mk") (baseDir -/- "mk" -/- "custom-settings.mk") - -- copyFile (cwd -/- "mk" -/- "project.mk") (baseDir -/- "mk" -/- "project.mk") buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake packge here. target (vanillaContext Stage1 ghc) (Tar Create) [ "bin", "lib", "configure", "config.sub", "config.guess" , "install-sh", "settings.in", "mk/config.mk.in", "mk/install.mk.in" - -- , "Makefile", "mk/project.mk", "mk/custom-settings.mk" - -- , "ghc.mk" + , "Makefile" ] [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] From 27896d4874aade9b8b2f80832c86c440ba2f593c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Tue, 5 Dec 2017 17:28:58 +0100 Subject: [PATCH 191/210] indentation --- shell.nix | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/shell.nix b/shell.nix index ce4d6961bc..46fcb9daa7 100644 --- a/shell.nix +++ b/shell.nix @@ -58,6 +58,6 @@ in nixpkgs.m4 nixpkgs.gmp nixpkgs.file - nixpkgs.llvm_5 + nixpkgs.llvm_5 ]; } From 8e0ff6a7ae8891936b4ec8bf9e7f8732d84a8420 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Fri, 8 Dec 2017 22:41:28 +0800 Subject: [PATCH 192/210] Cross always -fPIC This is definetly needed for the android cross compiler. --- src/Settings/Flavours/QuickCrossNG.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index c7fe846ac0..77da27cdbf 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -86,7 +86,7 @@ quickCrossNGFlavour = defaultFlavour quickCrossNGArgs :: Args quickCrossNGArgs = sourceArgs SourceArgs - { hsDefault = pure ["-O0", "-H64m"] + { hsDefault = pure ["-O0", "-H64m", "-fPIC"] , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvmng", arg "-fast-llvm" ] , hsCompiler = stage0 ? arg "-O" , hsGhc = mconcat From fbbab8799bc4f3385be0334d3c86a15fdc647ce4 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Sun, 10 Dec 2017 15:10:57 +0800 Subject: [PATCH 193/210] No shell for autoreconf. --- src/Builder.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Builder.hs b/src/Builder.hs index 43dd539217..5d7f650d3b 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -202,10 +202,7 @@ instance H.Builder Builder where Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs - Autoreconf dir -> do - bash <- bashPath - let env = AddEnv "CONFIG_SHELL" bash - cmd echo env [Cwd dir] ["sh", path] buildOptions buildArgs + Autoreconf dir -> cmd echo [Cwd dir] [path] buildOptions buildArgs Configure dir -> do -- Inject /bin/bash into `libtool`, instead of /bin/sh, From 26840be7900a1f043c9d9f078abfe60534de108d Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 11 Dec 2017 11:38:34 +0800 Subject: [PATCH 194/210] always fPIC --- src/Settings/Flavours/QuickCrossNG.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Settings/Flavours/QuickCrossNG.hs b/src/Settings/Flavours/QuickCrossNG.hs index 77da27cdbf..2b4b731cdf 100644 --- a/src/Settings/Flavours/QuickCrossNG.hs +++ b/src/Settings/Flavours/QuickCrossNG.hs @@ -87,8 +87,8 @@ quickCrossNGFlavour = defaultFlavour quickCrossNGArgs :: Args quickCrossNGArgs = sourceArgs SourceArgs { hsDefault = pure ["-O0", "-H64m", "-fPIC"] - , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvmng", arg "-fast-llvm" ] + , hsLibrary = notStage0 ? mconcat [ arg "-O", arg "-fllvmng", arg "-fast-llvm", arg "-fPIC" ] , hsCompiler = stage0 ? arg "-O" , hsGhc = mconcat [ stage0 ? arg "-O" - , stage1 ? mconcat [ arg "-O0", arg "-fllvmng", arg "-fast-llvm" ] ] } + , stage1 ? mconcat [ arg "-O0", arg "-fllvmng", arg "-fast-llvm", arg "-fPIC" ] ] } From 12397019f9dbc3b503158bf41f42b960f0a29e00 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 9 Jan 2018 09:20:24 +0800 Subject: [PATCH 195/210] Adds `USE_LIBFFI_FOR_ADJUSTORS` flag to the RTS package. --- src/Settings/Packages/Rts.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Settings/Packages/Rts.hs b/src/Settings/Packages/Rts.hs index 883f1a387f..5735e33ddd 100644 --- a/src/Settings/Packages/Rts.hs +++ b/src/Settings/Packages/Rts.hs @@ -124,6 +124,7 @@ rtsPackageArgs = package rts ? do , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM ghcWithSMP ? arg "-DNOSMP" + , useLibFFIForAdjustors ? arg "-DUSE_LIBFFI_FOR_ADJUSTORS" , inputs ["//RtsMessages.c", "//Trace.c"] ? arg ("-DProjectVersion=" ++ show projectVersion) From 323212d071d02e9435fb2c1eb3c47edd13cba195 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 9 Jan 2018 09:35:00 +0800 Subject: [PATCH 196/210] Add Show and Eq to BuildRoot. This seems to come up with 8.2.2. --- src/Hadrian/Utilities.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs index 45e0af72b8..e7953bad96 100644 --- a/src/Hadrian/Utilities.hs +++ b/src/Hadrian/Utilities.hs @@ -167,7 +167,7 @@ userSetting defaultValue = do extra <- shakeExtra <$> getShakeOptions return $ lookupExtra defaultValue extra -newtype BuildRoot = BuildRoot FilePath deriving Typeable +newtype BuildRoot = BuildRoot FilePath deriving (Typeable, Show, Eq) -- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the -- setting is not found, return the provided default value instead. From 6c401cf25222f6a4e8e7a6bb125c441345084e1d Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Wed, 10 Jan 2018 11:55:34 +0100 Subject: [PATCH 197/210] hopefully fix all documentation rules --- shell.nix | 43 +++++++++++--------- src/Hadrian/Haskell/Cabal/Parse.hs | 1 + src/Rules/Documentation.hs | 63 +++++++++++++++++++----------- src/Settings/Builders/Haddock.hs | 21 ++++++---- src/Types/ConfiguredCabal.hs | 5 ++- 5 files changed, 82 insertions(+), 51 deletions(-) diff --git a/shell.nix b/shell.nix index c7c7c228a7..a2079eb983 100644 --- a/shell.nix +++ b/shell.nix @@ -2,11 +2,13 @@ # by only invoking hadrian. -{ nixpkgs ? import {} }: +{ nixpkgs ? import {} +, boot-ghc ? "ghc821" }: let - haskellPackages = nixpkgs.haskell.packages.ghc821; - + ourtexlive = nixpkgs.texlive.combine + { inherit (nixpkgs.texlive) scheme-small fncychap; }; + haskellPackages = nixpkgs.haskell.packages.${boot-ghc}; removeBuild = path: type: let baseName = baseNameOf (toString path); in @@ -20,33 +22,35 @@ let || nixpkgs.lib.hasSuffix ".sh" baseName || !(nixpkgs.lib.cleanSourceFilter path type)) ; - filterSrc = path: builtins.filterSource removeBuild path; - + filterSrc = path: builtins.filterSource removeBuild path ; - hadrianPackages = nixpkgs.haskell.packages.ghc821.override { + hadrianPackages = haskellPackages.override { overrides = self: super: let - localPackage = name: path: self.callCabal2nix name (filterSrc path) {}; + localPackage = name: path: self.callCabal2nix name (filterSrc path) {} ; + noCheck = nixpkgs.haskell.lib.dontCheck ; in { hadrian = localPackage "hadrian" ./. ; - shake = self.callHackage "shake" "0.16" {}; - Cabal = localPackage "Cabal" ./../libraries/Cabal/Cabal ; - filepath = localPackage "filepath" ./../libraries/filepath ; - text = localPackage "text" ./../libraries/text ; - hpc = localPackage"hpc" ./../libraries/hpc ; - parsec = localPackage "parsec" ./../libraries/parsec ; - HUnit = nixpkgs.haskell.lib.dontCheck (self.callHackage "HUnit" "1.3.1.2" {}); - process = localPackage "process" ./../libraries/process ; - directory = localPackage "directory" ./../libraries/directory ; + shake = noCheck (self.callHackage "shake" "0.16" {}) ; + Cabal = noCheck (localPackage "Cabal" ./../libraries/Cabal/Cabal) ; + filepath = noCheck (localPackage "filepath" ./../libraries/filepath) ; + text = noCheck (localPackage "text" ./../libraries/text) ; + hpc = noCheck (localPackage "hpc" ./../libraries/hpc) ; + parsec = noCheck (localPackage "parsec" ./../libraries/parsec) ; + HUnit = noCheck (self.callHackage "HUnit" "1.3.1.2" {}) ; + process = noCheck (localPackage "process" ./../libraries/process) ; + directory = noCheck (localPackage "directory" ./../libraries/directory) ; }; }; in - nixpkgs.lib.overrideDerivation nixpkgs.haskell.packages.ghcHEAD.ghc + nixpkgs.lib.overrideDerivation + (nixpkgs.haskell.compiler.ghcHEAD.override { + bootPkgs = haskellPackages; + }) (drv: { name = "ghc-dev"; buildInputs = drv.buildInputs ++ [ hadrianPackages.hadrian nixpkgs.arcanist - nixpkgs.haskell.compiler.ghc821 haskellPackages.alex haskellPackages.happy nixpkgs.python3 @@ -61,5 +65,6 @@ in nixpkgs.gmp nixpkgs.file nixpkgs.llvm_5 + ourtexlive ]; - } + }) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 54ba047b12..065a3e0a41 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -265,6 +265,7 @@ parseConfiguredCabal context@Context {..} = do , 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 diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index d605e21cac..9e6a81f6bf 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -8,11 +8,13 @@ module Rules.Documentation ( import Base import Context -import Types.Flavour +import Expression (getConfiguredCabalData, interpretInContext) import GHC import Oracles.ModuleFiles import Settings import Target +import qualified Types.ConfiguredCabal as ConfCabal +import Types.Flavour import Utilities -- | Build all documentation @@ -107,10 +109,14 @@ buildLibraryDocumentation :: Rules () buildLibraryDocumentation = do root <- buildRootRules root -/- htmlRoot -/- "libraries/index.html" %> \file -> do + need [ root -/- "stage1/lib/llvm-targets" ] 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] @@ -119,13 +125,13 @@ allHaddocks = do sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ] -haddockHtmlLib :: FilePath -haddockHtmlLib = "inplace/lib/html/haddock-util.js" +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 - depNames <- pure $ error "lookup DEP_NAMES via configuredCabalData" -- pkgDataList $ DepNames path +haddockDependencies context = do + depNames <- interpretInContext context (getConfiguredCabalData ConfCabal.depNames) sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg | Just depPkg <- map findPackageByName depNames, depPkg /= rts ] @@ -133,27 +139,38 @@ 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) $ haddockHtmlLib %> \_ -> do - let dir = takeDirectory haddockHtmlLib + 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 <- buildRootRules - root -/- pkgName package <.> "haddock" %> \file -> do - haddocks <- haddockDependencies context - srcs <- hsSources context - need $ srcs ++ haddocks ++ [haddockHtmlLib] - - -- 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 @@ -166,7 +183,7 @@ buildPdfDocumentation = mapM_ buildSphinxPdf docPaths buildSphinxPdf :: FilePath -> Rules () buildSphinxPdf path = do root <- buildRootRules - root -/- path <.> "pdf" %> \file -> do + root -/- pdfRoot -/- path <.> "pdf" %> \file -> do let context = vanillaContext Stage0 docPackage withTempDir $ \dir -> do build $ target context (Sphinx Latex) [pathPath path] [dir] diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index ded6ff81b7..627d9a2fdd 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -7,20 +7,23 @@ import Rules.Documentation import Settings.Builders.Common import Settings.Builders.Ghc import Types.ConfiguredCabal as ConfCabal +import qualified Types.Context -- | 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 $ \ctx -> mconcat [ builder (Haddock BuildIndex) ? do output <- getOutput inputs <- getInputs + root <- getBuildRoot + stg <- Types.Context.stage <$> getContext 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" @@ -33,6 +36,8 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat output <- getOutput pkg <- getPackage path <- getBuildPath + root <- getBuildRoot + stg <- Types.Context.stage <$> getContext Just version <- expr $ pkgVersion ctx Just synopsis <- expr $ pkgSynopsis ctx deps <- getConfiguredCabalData ConfCabal.depNames @@ -40,7 +45,9 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat Just hVersion <- expr $ pkgVersion ctx ghcOpts <- haddockGhcArgs mconcat - [ arg $ "--odir=" ++ takeDirectory output + [ arg $ "-B" ++ root -/- "stage1" -/- "lib" + , arg $ "--lib=" ++ root -/- "lib" + , arg $ "--odir=" ++ takeDirectory output , arg "--verbosity=0" , arg "--no-tmp-comp-dir" , arg $ "--dump-interface=" ++ output @@ -49,14 +56,14 @@ haddockBuilderArgs = withHsPackage $ \ctx -> mconcat , arg "--hoogle" , 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" diff --git a/src/Types/ConfiguredCabal.hs b/src/Types/ConfiguredCabal.hs index c65f7823de..9b9c3933a6 100644 --- a/src/Types/ConfiguredCabal.hs +++ b/src/Types/ConfiguredCabal.hs @@ -14,6 +14,7 @@ data ConfiguredCabal = ConfiguredCabal , modules :: [String] , otherModules :: [String] , synopsis :: String + , description :: String , srcDirs :: [String] , deps :: [String] , depIpIds :: [String] @@ -47,8 +48,8 @@ instance Hashable ConfiguredCabal where 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) + 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` () + `seq` ae `seq` af `seq` () From 43741544fccf767f1ad1b6788d66e4d3d1fd4b2c Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 18 Jan 2018 16:08:44 +0100 Subject: [PATCH 198/210] embed docs in binary distributions --- src/Rules.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 9b16850308..23b07121e4 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -40,7 +40,7 @@ topLevelTargets = do -- 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"] + need ["stage2", "docs"] version <- setting ProjectVersion cwd <- liftIO getCurrentDirectory binDistDir <- getEnvWithDefault cwd "BINARY_DIST_DIR" @@ -62,11 +62,16 @@ topLevelTargets = do copyFile (cwd -/- "settings.in") (baseDir -/- "settings.in") copyFile (cwd -/- "mk" -/- "config.mk.in") (baseDir -/- "mk" -/- "config.mk.in") copyFile (cwd -/- "mk" -/- "install.mk.in") (baseDir -/- "mk" -/- "install.mk.in") + copyDirectory (takeDirectory baseDir -/- "docs") baseDir + + -- 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 packge here. + -- ghc is a fake package here. target (vanillaContext Stage1 ghc) (Tar Create) - [ "bin", "lib", "configure", "config.sub", "config.guess" + [ "bin", "lib", "docs", "configure", "config.sub", "config.guess" , "install-sh", "settings.in", "mk/config.mk.in", "mk/install.mk.in" , "Makefile" ] From 4af3d50e69cbb4b5fc7de27d1e604a5906e6f151 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 18 Jan 2018 20:29:21 +0100 Subject: [PATCH 199/210] binary-dist: create tar archive of a single folder, for cleaner extraction --- src/Rules.hs | 31 +++++++++++++++++++------------ src/Rules/Documentation.hs | 2 +- 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/Rules.hs b/src/Rules.hs index 23b07121e4..d68198ff09 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -52,17 +52,23 @@ topLevelTargets = do 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") (baseDir -/- "configure") - copyFile (cwd -/- "distrib" -/- "Makefile") (baseDir -/- "Makefile") - copyFile (cwd -/- "install-sh") (baseDir -/- "install-sh") - copyFile (cwd -/- "config.sub") (baseDir -/- "config.sub") - copyFile (cwd -/- "config.guess") (baseDir -/- "config.guess") - copyFile (cwd -/- "settings.in") (baseDir -/- "settings.in") - copyFile (cwd -/- "mk" -/- "config.mk.in") (baseDir -/- "mk" -/- "config.mk.in") - copyFile (cwd -/- "mk" -/- "install.mk.in") (baseDir -/- "mk" -/- "install.mk.in") - copyDirectory (takeDirectory baseDir -/- "docs") baseDir + 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 @@ -71,11 +77,12 @@ topLevelTargets = do buildWithCmdOptions [Cwd baseDir] $ -- ghc is a fake package here. target (vanillaContext Stage1 ghc) (Tar Create) - [ "bin", "lib", "docs", "configure", "config.sub", "config.guess" + [ ghcVersionPretty ] + {- [ "bin", "lib", "docs", "configure", "config.sub", "config.guess" , "install-sh", "settings.in", "mk/config.mk.in", "mk/install.mk.in" , "Makefile" - ] - [binDistDir -/- "ghc-" ++ version ++ "-" ++ targetPlatform ++ ".tar.xz"] + ] -} + [binDistDir -/- ghcVersionPretty ++ ".tar.xz"] phony "stage2" $ do putNormal "Building stage2" diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 9e6a81f6bf..6b1bbcec7d 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -31,7 +31,7 @@ documentationRules = do let html = htmlRoot -/- "index.html" archives = map pathArchive docPaths pdfs = map pathPdf $ docPaths \\ [ "libraries" ] - need $ map (root -/-) $ [html] ++ archives ++ pdfs + need $ map (root -/-) $ [html] ++ archives -- ++ pdfs need [ root -/- htmlRoot -/- "libraries" -/- "gen_contents_index" ] need [ root -/- htmlRoot -/- "libraries" -/- "prologue.txt" ] need [manPagePath] From 580c8a8408333d474981bf63bb24fe933a91def1 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 22 Jan 2018 18:42:59 +0100 Subject: [PATCH 200/210] document why we need 'stage/lib/llvm-targets' for the docs --- src/Rules/Documentation.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 9e6a81f6bf..4d5ddf23f8 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -109,6 +109,11 @@ buildLibraryDocumentation :: Rules () buildLibraryDocumentation = do root <- buildRootRules root -/- htmlRoot -/- "libraries/index.html" %> \file -> do + -- If we omit this, the 'docs' rule fails with an error + -- complaining about this file not being there: + -- https://gist.github.com/alpmestan/f0709cdf001efe1dd35ed1c7a216fc71 + -- when running e.g: + -- hadrian/build.nix.sh --flavour=quick-with-ng -j3 docs need [ root -/- "stage1/lib/llvm-targets" ] haddocks <- allHaddocks let libDocs = filter (\x -> takeFileName x `notElem` [ "ghc.haddock" From b81a0fb58aa53e23362d2684aacbe9daf6629aba Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 5 Feb 2018 12:34:54 +0800 Subject: [PATCH 201/210] Update to repect new Cabal. --- src/Hadrian/Haskell/Cabal/Parse.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index af9d5c845b..b75a0f433d 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -26,7 +26,7 @@ import Data.List.Extra import Development.Shake hiding (doesFileExist) import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C -import qualified Distribution.PackageDescription.Parse as C +import qualified Distribution.PackageDescription.Parsec as C import qualified Distribution.PackageDescription.Configuration as C import qualified Distribution.Text as C import qualified Distribution.Types.MungedPackageId as C (mungedName) @@ -41,6 +41,7 @@ import qualified Distribution.Simple.Utils as C (findHookedPackageDe 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 @@ -97,7 +98,7 @@ parseCabal context@Context {..} = do let (Just file) = pkgCabalFile package -- read the package description from the cabal file - gpd <- liftIO $ C.readGenericPackageDescription C.silent file + gpd <- liftIO $ C.readGenericPackageDescription C.verbose file -- configure the package with the ghc compiler for this stage. hcPath <- builderPath' (Ghc CompileHs stage) @@ -114,7 +115,7 @@ parseCabal context@Context {..} = do let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (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) . C.buildDepends $ pd + 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 From 19980b7955f186fd5f42ace71bfbcd6fd4ae38ff Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 5 Feb 2018 17:58:47 +0800 Subject: [PATCH 202/210] More GMP fixes. --- src/Rules/Gmp.hs | 12 ++++-------- src/Settings/Builders/Common.hs | 5 +++++ src/Settings/Builders/Ghc.hs | 9 +-------- 3 files changed, 10 insertions(+), 16 deletions(-) diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index 1e2f71fcb7..4bc9cd6a89 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) @@ -49,7 +45,7 @@ gmpRules = 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 @@ -78,7 +74,7 @@ gmpRules = do need [gmpPath -/- gmpLibraryH] -- This causes integerGmp package to be configured, hence creating the files - [gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ -> do + root "gmp/config.mk" %> \_ -> do -- setup-config, triggers `ghc-cabal configure` -- everything of a package should depend on that -- in the first place. diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index fe209ae3c7..5e3fd3de21 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -35,6 +35,11 @@ cIncludeArgs = do , 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 ] ] diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 6df95170ac..7c7fa2c1aa 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -3,7 +3,6 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where import Hadrian.Haskell.Cabal import Types.Flavour -import Rules.Gmp import Settings.Builders.Common import Types.ConfiguredCabal as ConfCabal import Settings.Warnings @@ -49,17 +48,11 @@ compileC = builder (Ghc CompileCWithGhc) ? do ghcLinkArgs :: Args ghcLinkArgs = builder (Ghc LinkHs) ? do - stage <- getStage way <- getWay pkg <- getPackage 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" From 6b1d22d0e46f21232f014e1ec4a28d55b45cdd63 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 7 Feb 2018 13:56:46 +0800 Subject: [PATCH 203/210] cleanup --- src/Hadrian/Haskell/Cabal/Parse.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index b75a0f433d..59263a9d95 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -179,7 +179,6 @@ copyPackage context@Context {..} = do copyHooks = userHooks hooks = copyHooks - -- we would need `withCurrentDirectory (pkgPath package)` liftIO $ defaultMainWithHooksNoReadArgs hooks gpd ["copy", "--builddir", ctxPath, "--target-package-db", pkgDbPath] registerPackage :: Context -> Action () @@ -190,7 +189,8 @@ registerPackage context@Context {..} = do let userHooks = Hooks.autoconfUserHooks regHooks = userHooks - liftIO $ defaultMainWithHooksNoReadArgs regHooks gpd ["register", "--builddir", ctxPath] + liftIO $ + defaultMainWithHooksNoReadArgs regHooks gpd ["register", "--builddir", ctxPath] -- | Parse a ConfiguredCabal file. parseConfiguredCabal :: Context -> Action ConfiguredCabal From 03550544162f23c4f5bb960e586c696cfedcaca1 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Mon, 12 Feb 2018 14:12:56 +0800 Subject: [PATCH 204/210] No versionsH --- src/Rules/Generate.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index deca181feb..e1db3a3afa 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -51,9 +51,6 @@ primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" platformH :: Stage -> FilePath platformH stage = buildDir (vanillaContext stage compiler) -/- "ghc_boot_platform.h" -versionsH :: Stage -> FilePath -versionsH stage = buildDir (vanillaContext stage compiler) -/- "HsVersions.h" - isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -149,7 +146,6 @@ generatePackageCode context@(Context stage pkg _) = do root -/- primopsTxt stage %> \file -> do root <- buildRoot need $ [ root -/- platformH stage - , root -/- versionsH stage , primopsSource] ++ fmap (root -/-) includesDependencies build $ target context HsCpp [primopsSource] [file] @@ -159,7 +155,6 @@ generatePackageCode context@(Context stage pkg _) = do when (stage == Stage0) $ do root "compiler/ghc_boot_platform.h" %> go generateGhcBootPlatformH root platformH stage %> go generateGhcBootPlatformH - (root versionsH stage) <~ return "compiler" when (pkg == rts) $ do root dir -/- "cmm/AutoApply.cmm" %> \file -> From f7db9b4e6021ff44b9e2ff9016a76bdd05cb6254 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 13 Feb 2018 14:35:54 +0800 Subject: [PATCH 205/210] iserv/libiserv logic --- src/GHC.hs | 1 + src/GHC/Packages.hs | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/GHC.hs b/src/GHC.hs index 2b959b38dd..62f6fc6f33 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -92,6 +92,7 @@ stage1Packages = do ++ [ haddock | not cross ] ++ [ runGhc | not cross ] ++ [ hpcBin | not cross ] + ++ [ libiserv | not win, not cross ] ++ [ iservBin | not win, not cross ] ++ [ unix | not win ] ++ [ win32 | win ] diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 8549d34c49..6115f32a15 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -19,7 +19,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 + , transformers, unlit, unix, win32, xhtml, libiserv ] -- TODO: Optimise by switching to sets of packages. @@ -80,6 +80,8 @@ 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 From e3d27af408bfd9cfa0557028b55457c224d03407 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 13 Feb 2018 14:49:33 +0800 Subject: [PATCH 206/210] Adds -fllvmng flag --- hadrian.cabal | 10 ++++++++-- src/Settings.hs | 17 ++++++++++++++--- 2 files changed, 22 insertions(+), 5 deletions(-) diff --git a/hadrian.cabal b/hadrian.cabal index 133991c79f..bafa0e0aa9 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -10,6 +10,9 @@ category: Development build-type: Simple cabal-version: >=1.10 +flag llvmng + default: false + source-repository head type: git location: https://github.com/snowleopard/hadrian @@ -86,9 +89,7 @@ executable hadrian , Settings.Flavours.Performance , Settings.Flavours.Profiled , Settings.Flavours.Quick - , Settings.Flavours.QuickWithNG , Settings.Flavours.QuickCross - , Settings.Flavours.QuickCrossNG , Settings.Flavours.Quickest , Settings.Packages , Settings.Packages.Rts @@ -106,6 +107,11 @@ executable hadrian , UserSettings , Utilities , Way + if flag(llvmng) + other-modules: Settings.Flavours.QuickWithNG + , Settings.Flavours.QuickCrossNG + cpp-options: -DLLVMNG + default-language: Haskell2010 default-extensions: DeriveFunctor , DeriveGeneric diff --git a/src/Settings.hs b/src/Settings.hs index 39d8bbcfca..e9a2e09fd3 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Settings ( getArgs, getLibraryWays, getRtsWays, flavour, knownPackages, findPackageByName, isLibrary, stagePackages, @@ -14,10 +15,12 @@ import Settings.Flavours.Profiled import Settings.Flavours.Quick import Settings.Flavours.Quickest import Settings.Flavours.QuickCross -import Settings.Flavours.QuickCrossNG -import Settings.Flavours.QuickWithNG import UserSettings import GHC.Packages +#if defined(LLVMNG) +import Settings.Flavours.QuickCrossNG +import Settings.Flavours.QuickWithNG +#endif getArgs :: Args getArgs = expr flavour >>= args @@ -37,7 +40,15 @@ hadrianFlavours :: [Flavour] hadrianFlavours = [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2 , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour - , quickCrossFlavour, quickCrossNGFlavour, quickWithNGFlavour ] + , quickCrossFlavour + -- TODO: if we have flavours that refer to packages + -- we incorrectly eagerly load those packages + -- and cabal files; which will fail if said + -- package does not exist. +#if defined(LLVMNG) + , quickCrossNGFlavour, quickWithNGFlavour +#endif + ] extraFlavourPackages :: [Package] extraFlavourPackages = nub . sort $ concatMap extraPackages hadrianFlavours From 950515995a8e0f5b34fbed3f895752e5ae09f8f8 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 14 Feb 2018 09:37:47 +0800 Subject: [PATCH 207/210] Profing flag --- src/Settings/Builders/GhcCabal.hs | 1 + src/Settings/Packages.hs | 2 ++ 2 files changed, 3 insertions(+) diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 5a7ea56750..4c3e90fdd8 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -65,6 +65,7 @@ ghcCabalBuilderArgs = mconcat -- 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 diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index 7d1600ee75..5a96076f08 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -120,4 +120,6 @@ packageArgs = do , arg ("--gcc-options=" ++ includeGmp) ] ] , package runGhc ? builder Ghc ? input "//Main.hs" ? pure ["-cpp", "-DVERSION=" ++ show version] + , package rts + ? builder CabalFlags ? (profiling `elem` rtsWays) ? arg "profiling" ] From f0a39fda5b49b9e4b160ca4fba531c8807c9fb5f Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Wed, 14 Feb 2018 19:27:47 +0800 Subject: [PATCH 208/210] Flags. --- src/Rules/Generate.hs | 2 +- src/Settings/Packages.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index e1db3a3afa..aa43d8ad4b 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -388,7 +388,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/Settings/Packages.hs b/src/Settings/Packages.hs index 5a96076f08..7ad6a900f8 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -61,7 +61,7 @@ packageArgs = do , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS" , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP" , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP" - , (threaded `elem` rtsWays) ? + , (any (wayUnit Threaded) rtsWays) ? notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS" , ghcWithInterpreter ? ghcEnableTablesNextToCode ? @@ -121,5 +121,5 @@ packageArgs = do , package runGhc ? builder Ghc ? input "//Main.hs" ? pure ["-cpp", "-DVERSION=" ++ show version] , package rts - ? builder CabalFlags ? (profiling `elem` rtsWays) ? arg "profiling" + ? builder CabalFlags ? (any (wayUnit Profiling) rtsWays) ? arg "profiling" ] From 025197cfff002bb4464aa3ec2b9fc952b749d553 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 15 Feb 2018 15:00:51 +0100 Subject: [PATCH 209/210] Types.X modules become X.Type --- hadrian.cabal | 16 +++++------ src/Context.hs | 9 +++---- src/Context/Paths.hs | 3 +-- src/{Types/Context.hs => Context/Type.hs} | 9 +++---- src/Expression.hs | 10 +++---- .../Expression.hs => Expression/Type.hs} | 7 +++-- src/{Types => }/Flavour.hs | 8 +++--- src/GHC.hs | 4 +-- src/GHC/Packages.hs | 2 -- src/Hadrian/Haskell/Cabal.hs | 6 ++--- .../Haskell/Cabal/Configured.hs} | 4 +-- src/Hadrian/Haskell/Cabal/Parse.hs | 27 +++++++------------ src/Hadrian/Haskell/Cabal/Parse.hs-boot | 6 ++--- .../Haskell/Cabal/Type.hs} | 6 ++--- src/Hadrian/Oracles/TextFile.hs | 8 +++--- src/Hadrian/Package.hs | 3 +-- .../Package.hs => Hadrian/Package/Type.hs} | 2 +- src/Oracles/ModuleFiles.hs | 4 +-- src/Rules/Documentation.hs | 5 ++-- src/Rules/Generate.hs | 6 ++--- src/Rules/Library.hs | 9 ++++--- src/Rules/Program.hs | 5 ++-- src/Settings.hs | 8 +++--- src/Settings/Builders/Cc.hs | 4 +-- src/Settings/Builders/Common.hs | 2 +- src/Settings/Builders/Ghc.hs | 11 ++++---- src/Settings/Builders/GhcCabal.hs | 12 ++++----- src/Settings/Builders/Haddock.hs | 5 ++-- src/Settings/Builders/Hsc2Hs.hs | 6 ++--- src/Settings/Builders/RunTest.hs | 9 +++---- src/Settings/Default.hs | 4 +-- src/Settings/Default.hs-boot | 4 +-- src/Settings/Flavours/Development.hs | 2 +- src/Settings/Flavours/Performance.hs | 2 +- src/Settings/Flavours/Profiled.hs | 2 +- src/Settings/Flavours/Quick.hs | 4 +-- src/Settings/Flavours/QuickCross.hs | 4 +-- src/Settings/Flavours/Quickest.hs | 2 +- src/Settings/Packages.hs | 6 ++--- src/Stage.hs | 2 +- src/{Types/Stage.hs => Stage/Type.hs} | 3 +-- src/UserSettings.hs | 5 +--- src/Utilities.hs | 13 +++++---- src/Way.hs | 2 +- src/{Types/Way.hs => Way/Type.hs} | 3 ++- 45 files changed, 127 insertions(+), 147 deletions(-) rename src/{Types/Context.hs => Context/Type.hs} (84%) rename src/{Types/Expression.hs => Expression/Type.hs} (88%) rename src/{Types => }/Flavour.hs (92%) rename src/{Types/ConfiguredCabal.hs => Hadrian/Haskell/Cabal/Configured.hs} (96%) rename src/{Types/Cabal.hs => Hadrian/Haskell/Cabal/Type.hs} (91%) rename src/{Types/Package.hs => Hadrian/Package/Type.hs} (97%) rename src/{Types/Stage.hs => Stage/Type.hs} (97%) rename src/{Types/Way.hs => Way/Type.hs} (99%) diff --git a/hadrian.cabal b/hadrian.cabal index c96f5d6a14..21a88ba2bd 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -26,8 +26,11 @@ executable hadrian , CommandLine , Context , Context.Paths + , Context.Type , Environment , Expression + , Expression.Type + , Flavour , GHC , GHC.Packages , Hadrian.Builder @@ -37,12 +40,15 @@ executable hadrian , Hadrian.Builder.Types , Hadrian.Expression , Hadrian.Haskell.Cabal + , Hadrian.Haskell.Cabal.Configured , Hadrian.Haskell.Cabal.Parse + , Hadrian.Haskell.Cabal.Type , Hadrian.Oracles.ArgsHash , Hadrian.Oracles.DirectoryContents , Hadrian.Oracles.Path , Hadrian.Oracles.TextFile , Hadrian.Package + , Hadrian.Package.Type , Hadrian.Target , Hadrian.Utilities , Oracles.Flag @@ -95,18 +101,12 @@ executable hadrian , Settings.Packages.Rts , Settings.Warnings , Stage - , Types.Context - , Types.Package - , Types.Stage - , Types.Cabal - , Types.ConfiguredCabal - , Types.Expression - , Types.Flavour - , Types.Way + , Stage.Type , Target , UserSettings , Utilities , Way + , Way.Type if flag(llvmng) other-modules: Settings.Flavours.QuickWithNG , Settings.Flavours.QuickCrossNG diff --git a/src/Context.hs b/src/Context.hs index 4db7f0b1eb..4ebe76f173 100644 --- a/src/Context.hs +++ b/src/Context.hs @@ -13,13 +13,12 @@ module Context ( pkgGhciLibraryFile, pkgConfFile, objectPath, pkgId ) where -import Hadrian.Expression -import Hadrian.Haskell.Cabal - -import Types.Context -import Context.Paths import Base +import Context.Paths +import Context.Type +import Hadrian.Expression +import Hadrian.Haskell.Cabal import Oracles.Setting -- | Most targets are built only one way, hence the notion of 'vanillaContext'. diff --git a/src/Context/Paths.hs b/src/Context/Paths.hs index 327d2c7cdf..32ccf45cd4 100644 --- a/src/Context/Paths.hs +++ b/src/Context/Paths.hs @@ -1,9 +1,8 @@ module Context.Paths where import Base - +import Context.Type import Hadrian.Expression -import Types.Context -- | The directory to the current stage stageDir :: Context -> FilePath diff --git a/src/Types/Context.hs b/src/Context/Type.hs similarity index 84% rename from src/Types/Context.hs rename to src/Context/Type.hs index 476ea6a0cd..106cbb4429 100644 --- a/src/Types/Context.hs +++ b/src/Context/Type.hs @@ -1,8 +1,8 @@ -module Types.Context where +module Context.Type where -import Types.Stage -import Types.Package -import Way +import Hadrian.Package.Type +import Stage.Type +import Way.Type import GHC.Generics import Development.Shake.Classes @@ -18,4 +18,3 @@ data Context = Context instance Binary Context instance Hashable Context instance NFData Context - diff --git a/src/Expression.hs b/src/Expression.hs index 64d2d5c194..8fe0f992b7 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -22,15 +22,13 @@ module Expression ( module Context, ) where -import Hadrian.Expression hiding (Expr, Predicate, Args) -import Types.ConfiguredCabal (ConfiguredCabal) -import Hadrian.Oracles.TextFile (readConfiguredCabalFile) - -import Types.Expression - import Base 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) -- | Get values from a configured cabal stage. getConfiguredCabalData :: (ConfiguredCabal -> a) -> Expr a diff --git a/src/Types/Expression.hs b/src/Expression/Type.hs similarity index 88% rename from src/Types/Expression.hs rename to src/Expression/Type.hs index ddca009bae..a9abc61f7e 100644 --- a/src/Types/Expression.hs +++ b/src/Expression/Type.hs @@ -1,7 +1,7 @@ -module Types.Expression where +module Expression.Type where -import Types.Context -import Types.Way +import Context.Type +import Way.Type import {-# SOURCE #-} Builder import qualified Hadrian.Expression as H @@ -15,4 +15,3 @@ type Expr a = H.Expr Context Builder a type Predicate = H.Predicate Context Builder type Args = H.Args Context Builder type Ways = Expr [Way] - diff --git a/src/Types/Flavour.hs b/src/Flavour.hs similarity index 92% rename from src/Types/Flavour.hs rename to src/Flavour.hs index 3a58c93d00..9df3e28e36 100644 --- a/src/Types/Flavour.hs +++ b/src/Flavour.hs @@ -1,9 +1,9 @@ -module Types.Flavour (Flavour (..)) where +module Flavour (Flavour (..)) where -import Types.Expression -import Types.Stage -import Types.Package import Development.Shake +import Expression.Type +import Hadrian.Package.Type +import Stage.Type -- Please update doc/{flavours.md, user-settings.md} when changing this file. -- | 'Flavour' is a collection of build settings that fully define a GHC build. diff --git a/src/GHC.hs b/src/GHC.hs index 2672ffda22..90225ed4a6 100644 --- a/src/GHC.hs +++ b/src/GHC.hs @@ -19,11 +19,11 @@ module GHC ( import Base import Context +import Flavour (integerLibrary) +import GHC.Packages import Oracles.Flag import Oracles.Setting -import Types.Flavour (integerLibrary) import Settings (flavour) -import GHC.Packages -- | Packages that are built by default. You can change this in "UserSettings". defaultPackages :: Stage -> Action [Package] diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs index 6115f32a15..d6a12369db 100644 --- a/src/GHC/Packages.hs +++ b/src/GHC/Packages.hs @@ -1,8 +1,6 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module GHC.Packages where -import Types.Package - import Hadrian.Package import Hadrian.Utilities diff --git a/src/Hadrian/Haskell/Cabal.hs b/src/Hadrian/Haskell/Cabal.hs index ef95a77490..2baee600e6 100644 --- a/src/Hadrian/Haskell/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal.hs @@ -13,11 +13,11 @@ module Hadrian.Haskell.Cabal ( pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis ) where -import Types.Context -import Types.Cabal as C -import Types.ConfiguredCabal as CC import Development.Shake +import Context.Type +import Hadrian.Haskell.Cabal.Type as C +import Hadrian.Haskell.Cabal.Configured as CC import Hadrian.Package import Hadrian.Oracles.TextFile diff --git a/src/Types/ConfiguredCabal.hs b/src/Hadrian/Haskell/Cabal/Configured.hs similarity index 96% rename from src/Types/ConfiguredCabal.hs rename to src/Hadrian/Haskell/Cabal/Configured.hs index 9b9c3933a6..e20faae30e 100644 --- a/src/Types/ConfiguredCabal.hs +++ b/src/Hadrian/Haskell/Cabal/Configured.hs @@ -1,7 +1,7 @@ -module Types.ConfiguredCabal where +module Hadrian.Haskell.Cabal.Configured where import Development.Shake.Classes -import Types.Package +import Hadrian.Package.Type import GHC.Generics data ConfiguredCabal = ConfiguredCabal diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 59263a9d95..c7019c08a2 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -19,11 +19,10 @@ module Hadrian.Haskell.Cabal.Parse ( ConfiguredCabal (..) ) where -import Types.Context -import {-# SOURCE #-} Builder hiding (Builder) --- import Hadrian.Builder as H import Data.List.Extra +import Data.Maybe (maybeToList, fromMaybe ) import Development.Shake hiding (doesFileExist) +import qualified Distribution.ModuleName as ModuleName import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C import qualified Distribution.PackageDescription.Parsec as C @@ -48,26 +47,20 @@ import qualified Distribution.Types.LocalBuildInfo as C import Distribution.Text (display) import Distribution.Simple (defaultMainWithHooksNoReadArgs, compilerFlavor, CompilerFlavor( GHC )) import Distribution.Simple.Compiler (compilerInfo) -import Hadrian.Package -import Hadrian.Utilities -import qualified Distribution.ModuleName as ModuleName -import Data.Maybe (maybeToList, fromMaybe ) + +import Base +import Builder hiding (Builder) +import Context +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 Types.Cabal ( Cabal( Cabal ) ) -import Types.ConfiguredCabal -import Types.Flavour (args) - import Settings import Oracles.Setting -import Context - -import Hadrian.Oracles.TextFile - -import Base - -- TODO: Use fine-grain tracking instead of tracking the whole Cabal file. -- | Haskell package metadata extracted from a Cabal file. diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs-boot b/src/Hadrian/Haskell/Cabal/Parse.hs-boot index 20aaf7e9f4..56f2219c5c 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs-boot +++ b/src/Hadrian/Haskell/Cabal/Parse.hs-boot @@ -1,9 +1,9 @@ module Hadrian.Haskell.Cabal.Parse where -import Types.Context -import Types.Cabal (Cabal) -import Types.ConfiguredCabal (ConfiguredCabal) +import Context.Type import Development.Shake +import Hadrian.Haskell.Cabal.Type (Cabal) +import Hadrian.Haskell.Cabal.Configured (ConfiguredCabal) parseCabal :: Context -> Action Cabal parseConfiguredCabal :: Context -> Action ConfiguredCabal \ No newline at end of file diff --git a/src/Types/Cabal.hs b/src/Hadrian/Haskell/Cabal/Type.hs similarity index 91% rename from src/Types/Cabal.hs rename to src/Hadrian/Haskell/Cabal/Type.hs index 0f4c6cab0a..42c7061bdf 100644 --- a/src/Types/Cabal.hs +++ b/src/Hadrian/Haskell/Cabal/Type.hs @@ -1,9 +1,9 @@ -module Types.Cabal where +module Hadrian.Haskell.Cabal.Type where import Development.Shake.Classes -import Types.Package -import GHC.Generics import Distribution.PackageDescription (GenericPackageDescription, PackageDescription) +import GHC.Generics +import Hadrian.Package.Type data Cabal = Cabal { name :: PackageName diff --git a/src/Hadrian/Oracles/TextFile.hs b/src/Hadrian/Oracles/TextFile.hs index b76528d34c..8eff0ae37a 100644 --- a/src/Hadrian/Oracles/TextFile.hs +++ b/src/Hadrian/Oracles/TextFile.hs @@ -16,11 +16,11 @@ module Hadrian.Oracles.TextFile ( readCabalFile, readConfiguredCabalFile, textFileOracle ) where -import Stage -import Types.Context -import Types.Cabal -import Types.ConfiguredCabal +import Context.Type +import Hadrian.Haskell.Cabal.Type +import Hadrian.Haskell.Cabal.Configured import Hadrian.Package +import Stage import Control.Monad import qualified Data.HashMap.Strict as Map diff --git a/src/Hadrian/Package.hs b/src/Hadrian/Package.hs index 32e741256f..05b2c702de 100644 --- a/src/Hadrian/Package.hs +++ b/src/Hadrian/Package.hs @@ -26,10 +26,9 @@ module Hadrian.Package ( import Data.Maybe import Development.Shake.FilePath import GHC.Stack +import Hadrian.Package.Type import Hadrian.Utilities -import Types.Package - -- | Construct a C library package. cLibrary :: PackageName -> FilePath -> Package cLibrary = Package C Library diff --git a/src/Types/Package.hs b/src/Hadrian/Package/Type.hs similarity index 97% rename from src/Types/Package.hs rename to src/Hadrian/Package/Type.hs index 03973cf2ba..0be15fa3ed 100644 --- a/src/Types/Package.hs +++ b/src/Hadrian/Package/Type.hs @@ -1,4 +1,4 @@ -module Types.Package where +module Hadrian.Package.Type where import GHC.Generics import Development.Shake.Classes diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index 3b28d166b7..573b09f850 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -8,9 +8,9 @@ import qualified Data.HashMap.Strict as Map import Base import Builder import Context -import GHC import Expression -import Types.ConfiguredCabal as ConfCabal +import GHC +import Hadrian.Haskell.Cabal.Configured as ConfCabal newtype ModuleFiles = ModuleFiles (Stage, Package) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index 4021e34a4e..6fa8d0f6d9 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -6,15 +6,16 @@ module Rules.Documentation ( haddockDependencies ) where +import qualified Hadrian.Haskell.Cabal.Configured as ConfCabal + import Base import Context import Expression (getConfiguredCabalData, interpretInContext) +import Flavour import GHC import Oracles.ModuleFiles import Settings import Target -import qualified Types.ConfiguredCabal as ConfCabal -import Types.Flavour import Utilities -- | Build all documentation diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 4f65a3f8da..6c33d0d74b 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -5,17 +5,17 @@ module Rules.Generate ( import Base import Expression -import Types.Flavour +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 -import GHC.Packages -- | Track this file to rebuild generated files whenever it changes. trackGenerateHs :: Expr () diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index 248cef8fe4..a5c40ee7f1 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -3,21 +3,22 @@ module Rules.Library ( ) where import Hadrian.Haskell.Cabal -import Types.ConfiguredCabal as ConfCabal -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 Types.Flavour +import Flavour +import GHC.Packages import Oracles.ModuleFiles import Oracles.Setting import Rules.Gmp import Settings import Target import Utilities -import GHC.Packages + +import qualified System.Directory as IO archive :: Way -> String -> String archive way pkgId = "libHS" ++ pkgId ++ (waySuffix way <.> "a") diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index 036d45f9af..4b65d7c25e 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -1,19 +1,18 @@ module Rules.Program (buildProgram) where import Hadrian.Haskell.Cabal -import Types.ConfiguredCabal as ConfCabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Base import Context import Expression hiding (stage, way) +import GHC import Oracles.ModuleFiles import Oracles.Flag (crossCompiling) import Settings import Settings.Packages.Rts import Target import Utilities -import GHC.Packages -import GHC -- | TODO: Drop code duplication buildProgram :: [(Resource, Int)] -> Rules () diff --git a/src/Settings.hs b/src/Settings.hs index e9a2e09fd3..d67bf6e659 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -7,7 +7,10 @@ module Settings ( import CommandLine import Expression -import Types.Flavour +import Flavour +import GHC.Packages +import UserSettings + import {-# SOURCE #-} Settings.Default import Settings.Flavours.Development import Settings.Flavours.Performance @@ -15,13 +18,12 @@ import Settings.Flavours.Profiled import Settings.Flavours.Quick import Settings.Flavours.Quickest import Settings.Flavours.QuickCross -import UserSettings -import GHC.Packages #if defined(LLVMNG) import Settings.Flavours.QuickCrossNG import Settings.Flavours.QuickWithNG #endif + getArgs :: Args getArgs = expr flavour >>= args diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs index 5aec01c5fa..edea4e4a9f 100644 --- a/src/Settings/Builders/Cc.hs +++ b/src/Settings/Builders/Cc.hs @@ -1,8 +1,8 @@ module Settings.Builders.Cc (ccBuilderArgs) where -import Settings.Builders.Common -import Types.ConfiguredCabal as ConfCabal import Builder () +import Hadrian.Haskell.Cabal.Configured as ConfCabal +import Settings.Builders.Common ccBuilderArgs :: Args ccBuilderArgs = do diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index 5e3fd3de21..573f7a9240 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -16,7 +16,7 @@ import Settings import UserSettings import GHC.Packages -import Types.ConfiguredCabal as ConfCabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal cIncludeArgs :: Args cIncludeArgs = do diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 2e9ad53601..cfb18e3eb4 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -1,13 +1,12 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where -import Hadrian.Haskell.Cabal - -import Types.Flavour +import Flavour +import GHC import Settings.Builders.Common -import Types.ConfiguredCabal as ConfCabal import Settings.Warnings -import GHC.Packages -import GHC + +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs index 4c3e90fdd8..0382569781 100644 --- a/src/Settings/Builders/GhcCabal.hs +++ b/src/Settings/Builders/GhcCabal.hs @@ -2,15 +2,15 @@ module Settings.Builders.GhcCabal ( ghcCabalBuilderArgs ) where -import Hadrian.Haskell.Cabal - -import Context -import Types.Flavour -import Settings.Builders.Common import Data.Maybe (fromJust) -import Hadrian.Builder (getBuilderPath, needBuilder ) + 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 = mconcat diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs index 5c6232aa06..cbaf3717d0 100644 --- a/src/Settings/Builders/Haddock.hs +++ b/src/Settings/Builders/Haddock.hs @@ -1,12 +1,11 @@ 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 -import Types.ConfiguredCabal as ConfCabal -- | Given a version string such as "2.16.2" produce an integer equivalent. versionToInt :: String -> Int diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index ca4bd1ac31..8aa59a199e 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -1,10 +1,10 @@ module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where -import Settings.Builders.Common -import Types.ConfiguredCabal as ConfCabal +import Builder () import GHC (autogenPath) +import Hadrian.Haskell.Cabal.Configured as ConfCabal import Hadrian.Builder (getBuilderPath) -import Builder () +import Settings.Builders.Common hsc2hsBuilderArgs :: Args hsc2hsBuilderArgs = builder Hsc2Hs ? do diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 008249fe33..24ee9c962e 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -1,13 +1,12 @@ module Settings.Builders.RunTest (runTestBuilderArgs) where -import Hadrian.Utilities - import CommandLine (TestArgs(..), defaultTestArgs) -import Types.Flavour -import Rules.Test -import Settings.Builders.Common +import Flavour import GHC.Packages import Hadrian.Builder (getBuilderPath) +import Hadrian.Utilities +import Rules.Test +import Settings.Builders.Common -- Arguments to send to the runtest.py script. runTestBuilderArgs :: Args diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index cae36522a3..bd237ba7ac 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -10,7 +10,7 @@ import qualified Hadrian.Builder.Tar import CommandLine import Expression -import Types.Flavour +import Flavour import Oracles.Flag import Settings import Settings.Builders.Alex @@ -33,7 +33,7 @@ import Settings.Packages import Settings.Packages.Rts import Settings.Warnings -import Types.ConfiguredCabal as ConfCabal +import Hadrian.Haskell.Cabal.Configured as ConfCabal import {-# SOURCE #-} Builder import GHC.Packages diff --git a/src/Settings/Default.hs-boot b/src/Settings/Default.hs-boot index 82d12f2ae1..7cd6286174 100644 --- a/src/Settings/Default.hs-boot +++ b/src/Settings/Default.hs-boot @@ -3,8 +3,8 @@ module Settings.Default ( defaultArgs, defaultLibraryWays, defaultRtsWays, defaultFlavour, defaultSplitObjects ) where -import Types.Flavour -import Types.Expression +import Expression.Type +import Flavour data SourceArgs = SourceArgs { hsDefault :: Args diff --git a/src/Settings/Flavours/Development.hs b/src/Settings/Flavours/Development.hs index db7170a710..5919026cb0 100644 --- a/src/Settings/Flavours/Development.hs +++ b/src/Settings/Flavours/Development.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Development (developmentFlavour) where import Expression -import Types.Flavour +import Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/Performance.hs b/src/Settings/Flavours/Performance.hs index e5117d1a01..64ab4bce9d 100644 --- a/src/Settings/Flavours/Performance.hs +++ b/src/Settings/Flavours/Performance.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Performance (performanceFlavour) where import Expression -import Types.Flavour +import Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/Profiled.hs b/src/Settings/Flavours/Profiled.hs index eec869d7b3..d56cc10055 100644 --- a/src/Settings/Flavours/Profiled.hs +++ b/src/Settings/Flavours/Profiled.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Profiled (profiledFlavour) where import Expression -import Types.Flavour +import Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Flavours/Quick.hs b/src/Settings/Flavours/Quick.hs index ed357de023..d9229d6324 100644 --- a/src/Settings/Flavours/Quick.hs +++ b/src/Settings/Flavours/Quick.hs @@ -1,9 +1,9 @@ module Settings.Flavours.Quick (quickFlavour) where import Expression -import Types.Flavour -import {-# SOURCE #-} Settings.Default +import Flavour import Oracles.Flag (platformSupportsSharedLibs) +import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. quickFlavour :: Flavour diff --git a/src/Settings/Flavours/QuickCross.hs b/src/Settings/Flavours/QuickCross.hs index 6b851d8b1c..fe4befde21 100644 --- a/src/Settings/Flavours/QuickCross.hs +++ b/src/Settings/Flavours/QuickCross.hs @@ -1,10 +1,10 @@ module Settings.Flavours.QuickCross (quickCrossFlavour) where import Expression -import Types.Flavour +import Flavour +import GHC.Packages import Oracles.Flag import {-# SOURCE #-} Settings.Default -import GHC.Packages -- Please update doc/flavours.md when changing this file. quickCrossFlavour :: Flavour diff --git a/src/Settings/Flavours/Quickest.hs b/src/Settings/Flavours/Quickest.hs index abcb70ae60..a9dfb7087f 100644 --- a/src/Settings/Flavours/Quickest.hs +++ b/src/Settings/Flavours/Quickest.hs @@ -1,7 +1,7 @@ module Settings.Flavours.Quickest (quickestFlavour) where import Expression -import Types.Flavour +import Flavour import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index 7ad6a900f8..91adc61bfb 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -1,12 +1,12 @@ module Settings.Packages (packageArgs) where import Expression -import Settings -import Types.Flavour +import Flavour +import GHC.Packages import Oracles.Setting import Oracles.Flag -import GHC.Packages import Rules.Gmp +import Settings packageArgs :: Args packageArgs = do diff --git a/src/Stage.hs b/src/Stage.hs index 7cefb0c0d6..86472d296c 100644 --- a/src/Stage.hs +++ b/src/Stage.hs @@ -1,6 +1,6 @@ module Stage (Stage (..), stageString) where -import Types.Stage +import Stage.Type -- | Prettyprint a 'Stage'. stageString :: Stage -> String diff --git a/src/Types/Stage.hs b/src/Stage/Type.hs similarity index 97% rename from src/Types/Stage.hs rename to src/Stage/Type.hs index ea651412b1..e991849166 100644 --- a/src/Types/Stage.hs +++ b/src/Stage/Type.hs @@ -1,4 +1,4 @@ -module Types.Stage where +module Stage.Type where import Development.Shake.Classes import GHC.Generics @@ -25,4 +25,3 @@ data Stage = Stage0 | Stage1 | Stage2 | Stage3 instance Binary Stage instance Hashable Stage instance NFData Stage - diff --git a/src/UserSettings.hs b/src/UserSettings.hs index e08ec3339e..c494dfcd75 100644 --- a/src/UserSettings.hs +++ b/src/UserSettings.hs @@ -7,11 +7,8 @@ module UserSettings ( buildProgressColour, successColour, stage1Only ) where -import Hadrian.Utilities - -import Types.Flavour -import Types.Package import Expression +import Flavour import {-# SOURCE #-} Settings.Default -- See doc/user-settings.md for instructions. diff --git a/src/Utilities.hs b/src/Utilities.hs index 6288de5a4d..81dcb41897 100644 --- a/src/Utilities.hs +++ b/src/Utilities.hs @@ -4,17 +4,16 @@ module Utilities ( topsortPackages, ask, askWithResources, cabalDependencies ) where -import qualified Hadrian.Builder as H -import Hadrian.Haskell.Cabal -import Hadrian.Utilities - import Context import Expression hiding (stage) +import GHC.Packages +import Hadrian.Haskell.Cabal +import Oracles.Setting (windowsHost) import Settings import Target -import Types.ConfiguredCabal as ConfCabal -import Oracles.Setting (windowsHost) -import GHC.Packages + +import qualified Hadrian.Builder as H +import Hadrian.Haskell.Cabal.Configured as ConfCabal build :: Target -> Action () build target = H.build target getArgs diff --git a/src/Way.hs b/src/Way.hs index 57dc22fb2f..48fcde2ecf 100644 --- a/src/Way.hs +++ b/src/Way.hs @@ -9,7 +9,7 @@ module Way ( wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf ) where -import Types.Way +import Way.Type -- | Various combinations of RTS only ways. threadedDebug, threadedProfiling, threadedLogging, threadedDynamic, diff --git a/src/Types/Way.hs b/src/Way/Type.hs similarity index 99% rename from src/Types/Way.hs rename to src/Way/Type.hs index 69d12fe3d6..b8d6ee9d63 100644 --- a/src/Types/Way.hs +++ b/src/Way/Type.hs @@ -1,4 +1,5 @@ -module Types.Way where +module Way.Type where + import Development.Shake.Classes import Data.IntSet (IntSet) import qualified Data.IntSet as Set From b5d8e2d3d9185ac79d97506e6ab9a22bb1daf8e5 Mon Sep 17 00:00:00 2001 From: Moritz Angermann Date: Tue, 27 Feb 2018 20:33:06 +0800 Subject: [PATCH 210/210] Adds QuickCrossNCG flavour. --- hadrian.cabal | 1 + src/Settings.hs | 3 ++- src/Settings/Flavours/QuickCrossNCG.hs | 26 ++++++++++++++++++++++++++ 3 files changed, 29 insertions(+), 1 deletion(-) create mode 100644 src/Settings/Flavours/QuickCrossNCG.hs diff --git a/hadrian.cabal b/hadrian.cabal index 21a88ba2bd..699729416c 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -96,6 +96,7 @@ executable hadrian , Settings.Flavours.Profiled , Settings.Flavours.Quick , Settings.Flavours.QuickCross + , Settings.Flavours.QuickCrossNCG , Settings.Flavours.Quickest , Settings.Packages , Settings.Packages.Rts diff --git a/src/Settings.hs b/src/Settings.hs index d67bf6e659..97d377d1b3 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -18,6 +18,7 @@ import Settings.Flavours.Profiled import Settings.Flavours.Quick import Settings.Flavours.Quickest import Settings.Flavours.QuickCross +import Settings.Flavours.QuickCrossNCG #if defined(LLVMNG) import Settings.Flavours.QuickCrossNG import Settings.Flavours.QuickWithNG @@ -42,7 +43,7 @@ hadrianFlavours :: [Flavour] hadrianFlavours = [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2 , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour - , quickCrossFlavour + , quickCrossFlavour, quickCrossNCGFlavour -- TODO: if we have flavours that refer to packages -- we incorrectly eagerly load those packages -- and cabal files; which will fail if said diff --git a/src/Settings/Flavours/QuickCrossNCG.hs b/src/Settings/Flavours/QuickCrossNCG.hs new file mode 100644 index 0000000000..61561afba2 --- /dev/null +++ b/src/Settings/Flavours/QuickCrossNCG.hs @@ -0,0 +1,26 @@ +module Settings.Flavours.QuickCrossNCG (quickCrossNCGFlavour) where + +import Expression +import Flavour +import GHC.Packages +import Oracles.Flag +import {-# SOURCE #-} Settings.Default + +-- Please update doc/flavours.md when changing this file. +quickCrossNCGFlavour :: Flavour +quickCrossNCGFlavour = defaultFlavour + { name = "quick-cross-ncg" + , args = defaultBuilderArgs <> quickCrossArgs <> defaultPackageArgs + , integerLibrary = pure integerSimple + , libraryWays = mconcat + [ pure [vanilla] + , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] ] } + +quickCrossArgs :: Args +quickCrossArgs = sourceArgs SourceArgs + { hsDefault = pure ["-O0", "-H64m"] + , hsLibrary = notStage0 ? mconcat [ arg "-O" ] + , hsCompiler = stage0 ? arg "-O" + , hsGhc = mconcat + [ stage0 ? arg "-O" + , stage1 ? mconcat [ arg "-O0" ] ] }