diff options
32 files changed, 236 insertions, 149 deletions
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index de11ada4be..aefa6ee42f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -224,12 +224,12 @@ typecheck-testsuite: BUILD_FLAVOUR: default script: - .gitlab/ci.sh configure - - .gitlab/ci.sh run_hadrian stage1:exe:lint-submodule-refs + - .gitlab/ci.sh run_hadrian stage0:exe:lint-submodule-refs - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" $CI_MERGE_REQUEST_TARGET_BRANCH_NAME - base="$(git merge-base FETCH_HEAD $CI_COMMIT_SHA)" - "echo Linting submodule changes between $base..$CI_COMMIT_SHA" - git submodule foreach git remote update - - _build/stage0/bin/lint-submodule-refs . $(git rev-list $base..$CI_COMMIT_SHA) + - _build/stageBoot/bin/lint-submodule-refs . $(git rev-list $base..$CI_COMMIT_SHA) dependencies: [] # We allow the submodule checker to fail when run on merge requests (to @@ -287,10 +287,10 @@ lint-submods-branch: BUILD_FLAVOUR: default script: - .gitlab/ci.sh configure - - .gitlab/ci.sh run_hadrian stage1:exe:lint-submodule-refs + - .gitlab/ci.sh run_hadrian stage0:exe:lint-submodule-refs - "echo Linting submodule changes between $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA" - git submodule foreach git remote update - - _build/stage0/bin/lint-submodule-refs . $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) + - _build/stageBoot/bin/lint-submodule-refs . $(git rev-list $CI_COMMIT_BEFORE_SHA..$CI_COMMIT_SHA) rules: - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index b80ac59f8d..f3c6f80d41 100644 --- a/hadrian/src/Builder.hs +++ b/hadrian/src/Builder.hs @@ -199,18 +199,20 @@ 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 - Ghc _ Stage0 -> Nothing - Ghc _ stage -> context (pred stage) ghc - GhcPkg _ Stage0 -> Nothing - GhcPkg _ s -> context (pred s) ghcPkg + DeriveConstants -> context stage0Boot deriveConstants + GenApply -> context stage0Boot genapply + GenPrimopCode -> context stage0Boot genprimopcode + Ghc _ (Stage0 {})-> Nothing + Ghc _ stage -> context (predStage stage) ghc + GhcPkg _ (Stage0 {}) -> Nothing + GhcPkg _ s -> context (predStage s) ghcPkg Haddock _ -> context Stage1 haddock + Hsc2Hs _ -> context stage0Boot hsc2hs + Unlit -> context stage0Boot unlit + + -- Never used Hpc -> context Stage1 hpcBin - Hp2Ps -> context Stage0 hp2ps - Hsc2Hs _ -> context Stage0 hsc2hs - Unlit -> context Stage0 unlit + Hp2Ps -> context stage0Boot hp2ps _ -> Nothing where context s p = Just $ vanillaContext s p @@ -226,19 +228,19 @@ instance H.Builder Builder where Autoreconf dir -> return [dir -/- "configure.ac"] Configure dir -> return [dir -/- "configure"] - Ghc _ Stage0 -> do + Ghc _ (Stage0 {}) -> do -- Read the boot GHC version here to make sure we rebuild when it -- changes (#18001). _bootGhcVersion <- setting GhcVersion pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext Stage0 touchy) + touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the -- current stage. Need the previous stage's GHC deps. - ghcdeps <- ghcBinDeps (pred stage) + ghcdeps <- ghcBinDeps (predStage stage) return $ [ unlitPath ] ++ ghcdeps @@ -400,15 +402,15 @@ isOptional = \case systemBuilderPath :: Builder -> Action FilePath systemBuilderPath builder = case builder of Alex -> fromKey "alex" - Ar _ Stage0 -> fromKey "system-ar" + Ar _ (Stage0 {})-> fromKey "system-ar" Ar _ _ -> fromKey "ar" Autoreconf _ -> stripExe =<< fromKey "autoreconf" - Cc _ Stage0 -> fromKey "system-cc" + Cc _ (Stage0 {}) -> fromKey "system-cc" Cc _ _ -> fromKey "cc" -- We can't ask configure for the path to configure! Configure _ -> return "configure" - Ghc _ Stage0 -> fromKey "system-ghc" - GhcPkg _ Stage0 -> fromKey "system-ghc-pkg" + Ghc _ (Stage0 {}) -> fromKey "system-ghc" + GhcPkg _ (Stage0 {}) -> fromKey "system-ghc-pkg" Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" @@ -420,7 +422,7 @@ systemBuilderPath builder = case builder of -- parameters. E.g. building a cross-compiler on and for x86_64 -- which will target ppc64 means that MergeObjects Stage0 will use -- x86_64 linker and MergeObject _ will use ppc64 linker. - MergeObjects Stage0 -> fromKey "system-merge-objects" + MergeObjects (Stage0 {}) -> fromKey "system-merge-objects" MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs index ad6ead3f9b..ae1f329973 100644 --- a/hadrian/src/Context.hs +++ b/hadrian/src/Context.hs @@ -57,7 +57,7 @@ libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib")) distDir :: Stage -> Action FilePath distDir st = do let (os,arch) = case st of - Stage0 -> (HostOs , HostArch) + Stage0 {} -> (HostOs , HostArch) _ -> (TargetOs, TargetArch) version <- ghcVersionStage st hostOs <- cabalOsString <$> setting os diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs index 3d6b9b896c..14b08cb0e9 100644 --- a/hadrian/src/Expression.hs +++ b/hadrian/src/Expression.hs @@ -111,7 +111,10 @@ compiler. -- | Is the build currently in stage 0? stage0 :: Predicate -stage0 = stage Stage0 +stage0 = p <$> getStage + where + p (Stage0 {}) = True + p _ = False -- | Is the build currently in stage 1? stage1 :: Predicate @@ -123,7 +126,8 @@ stage2 = stage Stage2 -- | Is the build /not/ in stage 0 right now? notStage0 :: Predicate -notStage0 = notM stage0 +notStage0 = notM Expression.stage0 + -- | Whether or not the bootstrapping compiler provides a threaded RTS. We need -- to know this when building stage 1, since stage 1 links against the diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs index ecc127b69c..b74f72eb1a 100644 --- a/hadrian/src/Flavour.hs +++ b/hadrian/src/Flavour.hs @@ -53,7 +53,7 @@ flavourTransformers = M.fromList , "collect_timings" =: collectTimings , "assertions" =: enableAssertions , "debug_ghc" =: debugGhc Stage1 - , "debug_stage1_ghc" =: debugGhc Stage0 + , "debug_stage1_ghc" =: debugGhc stage0InTree , "lint" =: enableLinting , "haddock" =: enableHaddock ] @@ -515,7 +515,7 @@ builderSetting = , ("deps", FindCDependencies CDep) ] - stages = map (\stg -> (stageString stg, stg)) [minBound..maxBound] + stages = map (\stg -> (stageString stg, stg)) allStages pkgs = map (\pkg -> (pkgName pkg, pkg)) (ghcPackages ++ userPackages) diff --git a/hadrian/src/Hadrian/BuildPath.hs b/hadrian/src/Hadrian/BuildPath.hs index 8e059ce7d4..8d2806b587 100644 --- a/hadrian/src/Hadrian/BuildPath.hs +++ b/hadrian/src/Hadrian/BuildPath.hs @@ -72,10 +72,10 @@ parseGhcPkgPath root after = do -- To be kept in sync with Stage.hs's stageString function -- | Parse @"stageX"@ into a 'Stage'. parseStage :: Parsec.Parsec String () Stage -parseStage = (Parsec.string "stage" *> Parsec.choice - [ Parsec.string (show n) $> toEnum n - | n <- map fromEnum [minBound .. maxBound :: Stage] - ]) Parsec.<?> "stage string" +parseStage = Parsec.choice + [ n <$ Parsec.try (Parsec.string (stageString n)) + | n <- allStages + ] Parsec.<?> "stage string" -- To be kept in sync with the show instances in 'Way.Type', until we perhaps -- use some bidirectional parsing/pretty printing approach or library. diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs index 62a1ebcd67..dca0861869 100644 --- a/hadrian/src/Oracles/Setting.hs +++ b/hadrian/src/Oracles/Setting.hs @@ -182,15 +182,19 @@ setting key = lookupSystemConfig $ case key of TargetHasRtsLinker -> "target-has-rts-linker" BourneShell -> "bourne-shell" +bootIsStage0 :: Stage -> Stage +bootIsStage0 (Stage0 {}) = Stage0 InTreeLibs +bootIsStage0 s = s + -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the -- result. settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of - 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 - ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString stage + ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) + ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) + ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) + ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) + ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) HsCppArgs -> "hs-cpp-args" -- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the @@ -316,7 +320,7 @@ topDirectory :: Action FilePath topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath ghcVersionStage :: Stage -> Action String -ghcVersionStage Stage0 = setting GhcVersion +ghcVersionStage (Stage0 {}) = setting GhcVersion ghcVersionStage _ = setting ProjectVersion -- | The file suffix used for libraries of a given build 'Way'. For example, diff --git a/hadrian/src/Oracles/TestSettings.hs b/hadrian/src/Oracles/TestSettings.hs index 7956491414..5a27e0c5fb 100644 --- a/hadrian/src/Oracles/TestSettings.hs +++ b/hadrian/src/Oracles/TestSettings.hs @@ -118,7 +118,7 @@ fullPath stage pkg = programPath =<< programContext stage pkg -- stage 1 ghc lives under stage0/bin, -- stage 2 ghc lives under stage1/bin, etc stageOfTestCompiler :: String -> Maybe Stage -stageOfTestCompiler "stage1" = Just Stage0 +stageOfTestCompiler "stage1" = Just stage0InTree stageOfTestCompiler "stage2" = Just Stage1 stageOfTestCompiler "stage3" = Just Stage2 stageOfTestCompiler _ = Nothing diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs index 521c0ac154..9b432b8966 100644 --- a/hadrian/src/Rules.hs +++ b/hadrian/src/Rules.hs @@ -32,16 +32,12 @@ import Settings.Program (programContext) import Target import UserSettings - -allStages :: [Stage] -allStages = [minBound .. maxBound] - -- | This rule calls 'need' on all top-level build targets that Hadrian builds -- by default, respecting the 'finalStage' flag. topLevelTargets :: Rules () topLevelTargets = action $ do verbosity <- getVerbosity - forM_ [ Stage1 ..] $ \stage -> do + forM_ [ Stage1, Stage2, Stage3] $ \stage -> do when (verbosity >= Verbose) $ do (libraries, programs) <- partition isLibrary <$> stagePackages stage libNames <- mapM (name stage) libraries @@ -52,14 +48,14 @@ topLevelTargets = action $ do putInfo . unlines $ [ stageHeader "libraries" libNames , stageHeader "programs" pgmNames ] - let buildStages = [ s | s <- [Stage0 ..], s < finalStage ] + let buildStages = [ s | s <- allStages, s < finalStage ] targets <- concatForM buildStages $ \stage -> do packages <- stagePackages stage mapM (path stage) packages -- Why we need wrappers: https://gitlab.haskell.org/ghc/ghc/issues/16534. root <- buildRoot - let wrappers = [ root -/- ("ghc-" ++ stageString s) | s <- [Stage1 ..] + let wrappers = [ root -/- ("ghc-" ++ stageString s) | s <- [Stage1, Stage2, Stage3] , s < finalStage ] need (targets ++ wrappers) where @@ -117,7 +113,7 @@ packageRules = do Rules.Program.buildProgramRules readPackageDb Rules.Register.configurePackageRules - forM_ [Stage0 ..] (Rules.Register.registerPackageRules writePackageDb) + forM_ allStages (Rules.Register.registerPackageRules writePackageDb) -- TODO: Can we get rid of this enumeration of contexts? Since we iterate -- over it to generate all 4 types of rules below, all the time, we diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs index 9c98c85371..3902643079 100644 --- a/hadrian/src/Rules/BinaryDist.hs +++ b/hadrian/src/Rules/BinaryDist.hs @@ -204,17 +204,6 @@ bindistRules = do cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["recache"] - -- HACK: Drop stuff from lintersCommon package as this for GHC developers and not of interest to end-users (#21203) - pkg_id <- pkgIdentifier lintersCommon - cmd_ (bindistFilesDir -/- "bin" -/- ghcPkgName) ["unregister", pkg_id] - removeDirectory (bindistFilesDir -/- "lib" -/- distDir -/- pkg_id) - - removeFile =<< - ((bindistFilesDir -/- "lib" -/- distDir) -/-) - <$> pkgRegisteredLibraryFileName (Context Stage1 lintersCommon dynamic) - - - -- The settings file must be regenerated by the bindist installation -- logic to account for the environment discovered by the bindist -- configure script on the host. Not on Windows, however, where diff --git a/hadrian/src/Rules/Clean.hs b/hadrian/src/Rules/Clean.hs index 26a279d178..19e7f3be5b 100644 --- a/hadrian/src/Rules/Clean.hs +++ b/hadrian/src/Rules/Clean.hs @@ -22,7 +22,7 @@ clean = do cleanSourceTree :: Action () cleanSourceTree = do path <- buildRoot - forM_ [Stage0 ..] $ removeDirectory . (path -/-) . stageString + forM_ allStages $ removeDirectory . (path -/-) . stageString removeDirectory "sdistprep" cleanMingwTarballs :: Action () diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index ca96302db3..33a392fc33 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/hadrian/src/Rules/Generate.hs @@ -55,7 +55,7 @@ rtsDependencies = do genapplyDependencies :: Expr [FilePath] genapplyDependencies = do stage <- getStage - rtsPath <- expr (rtsBuildPath $ succ stage) + rtsPath <- expr (rtsBuildPath $ succStage stage) ((stage /= Stage3) ?) $ pure $ ((rtsPath -/- "include") -/-) <$> [ "ghcautoconf.h", "ghcplatform.h" ] @@ -175,7 +175,7 @@ genPlatformConstantsHeader context file = do copyRules :: Rules () copyRules = do root <- buildRootRules - forM_ [Stage0 ..] $ \stage -> do + forM_ allStages $ \stage -> do let prefix = root -/- stageString stage -/- "lib" infixl 1 <~ @@ -203,7 +203,7 @@ generateRules = do (root -/- "ghc-stage2") <~+ ghcWrapper Stage2 (root -/- "ghc-stage3") <~+ ghcWrapper Stage3 - forM_ [Stage0 ..] $ \stage -> do + forM_ allStages $ \stage -> do let prefix = root -/- stageString stage -/- "lib" go gen file = generate file (semiEmptyTarget stage) gen (prefix -/- "settings") %> go generateSettings @@ -227,11 +227,11 @@ emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage") -- | GHC wrapper scripts used for passing the path to the right package database -- when invoking in-tree GHC executables. ghcWrapper :: Stage -> Expr String -ghcWrapper Stage0 = error "Stage0 GHC does not require a wrapper script to run." +ghcWrapper (Stage0 {}) = error "Stage0 GHC does not require a wrapper script to run." ghcWrapper stage = do dbPath <- expr $ (</>) <$> topDirectory <*> packageDbPath stage ghcPath <- expr $ (</>) <$> topDirectory - <*> programPath (vanillaContext (pred stage) ghc) + <*> programPath (vanillaContext (predStage stage) ghc) return $ unwords $ map show $ [ ghcPath ] ++ (if stage == Stage1 then ["-no-global-package-db" @@ -250,7 +250,7 @@ generateGhcPlatformH :: Expr String generateGhcPlatformH = do trackGenerateHs stage <- getStage - let chooseSetting x y = getSetting $ if stage == Stage0 then x else y + let chooseSetting x y = getSetting $ case stage of { Stage0 {} -> x; _ -> y } buildPlatform <- chooseSetting BuildPlatform HostPlatform buildArch <- chooseSetting BuildArch HostArch buildOs <- chooseSetting BuildOs HostOs @@ -365,7 +365,7 @@ generateSettings = do generateConfigHs :: Expr String generateConfigHs = do stage <- getStage - let chooseSetting x y = getSetting $ if stage == Stage0 then x else y + let chooseSetting x y = getSetting $ case stage of { Stage0 {} -> x; _ -> y } buildPlatform <- chooseSetting BuildPlatform HostPlatform hostPlatform <- chooseSetting HostPlatform TargetPlatform trackGenerateHs @@ -398,8 +398,15 @@ generateConfigHs = do , "cBooterVersion = " ++ show cBooterVersion , "" , "cStage :: String" - , "cStage = show (" ++ show (fromEnum stage + 1) ++ " :: Int)" + , "cStage = show (" ++ stageString stage ++ " :: Int)" ] + where + stageString (Stage0 InTreeLibs) = "1" + stageString Stage1 = "2" + stageString Stage2 = "3" + stageString Stage3 = "4" + stageString (Stage0 GlobalLibs) = error "stageString: StageBoot" + -- | Generate @ghcautoconf.h@ header. generateGhcAutoconfH :: Expr String diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs index 8e62461202..860d06b116 100644 --- a/hadrian/src/Rules/Libffi.hs +++ b/hadrian/src/Rules/Libffi.hs @@ -156,7 +156,7 @@ libffiRules :: Rules () libffiRules = do _ <- addOracleCache $ \ (LibffiDynLibs stage) -> readFileLines =<< dynLibManifest stage - forM_ [Stage1 ..] $ \stage -> do + forM_ [Stage1, Stage2, Stage3] $ \stage -> do root <- buildRootRules let path = root -/- stageString stage libffiPath = path -/- pkgName libffi -/- "build" diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs index ad91e941cb..076c22987b 100644 --- a/hadrian/src/Rules/Program.hs +++ b/hadrian/src/Rules/Program.hs @@ -36,7 +36,7 @@ buildProgramRules rs = do writeFile' stampPath "OK" -- Rules for programs that are actually built by hadrian. - forM_ [Stage0 ..] $ \stage -> + forM_ allStages $ \stage -> [ root -/- stageString stage -/- "bin" -/- "*" , root -/- stageString stage -/- "lib/bin" -/- "*" ] |%> \bin -> do programContexts <- getProgramContexts stage @@ -78,13 +78,13 @@ lookupProgramContext wholePath progs = lookup (takeFileName wholePath) progs buildProgram :: FilePath -> Context -> [(Resource, Int)] -> Action () buildProgram bin ctx@(Context{..}) rs = do - -- Custom dependencies: this should be modeled better in the - -- Cabal file somehow. - -- TODO: Is this still needed? See 'runtimeDependencies'. + when (package == hsc2hs) $ do -- 'Hsc2hs' needs the @template-hsc.h@ file. template <- templateHscPath stage need [template] + -- Custom dependencies: this should be modeled better in the + -- Cabal file somehow. when (package == ghc) $ do need =<< ghcBinDeps stage when (package == haddock) $ do @@ -102,18 +102,18 @@ buildProgram bin ctx@(Context{..}) rs = do cross <- flag CrossCompiling -- For cross compiler, copy @stage0/bin/<pgm>@ to @stage1/bin/@. case (cross, stage) of - (True, s) | s > Stage0 -> do - srcDir <- buildRoot <&> (-/- (stageString Stage0 -/- "bin")) + (True, s) | s > stage0InTree -> do + srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > Stage0 && (package `elem` [touchy, unlit]) -> do - srcDir <- stageLibPath Stage0 <&> (-/- "bin") + (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx buildBinary :: [(Resource, Int)] -> FilePath -> Context -> Action () buildBinary rs bin context@Context {..} = do needLibrary =<< contextDependencies context - when (stage > Stage0) $ do + when (stage > stage0InTree) $ do ways <- interpretInContext context (getLibraryWays <> getRtsWays) needLibrary [ (rtsContext stage) { way = w } | w <- Set.toList ways ] asmSrcs <- interpretInContext context (getContextData asmSrcs) diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs index 8527864f77..64b32283cb 100644 --- a/hadrian/src/Rules/Register.hs +++ b/hadrian/src/Rules/Register.hs @@ -109,11 +109,12 @@ registerPackageRules rs stage = do when (pkg == compiler) $ need =<< ghcLibDeps stage - isBoot <- (pkg `notElem`) <$> stagePackages Stage0 + -- Only used in guard when Stage0 {} but can be GlobalLibs or InTreeLibs + isBoot <- (pkg `notElem`) <$> stagePackages stage let ctx = Context stage pkg vanilla case stage of - Stage0 | isBoot -> copyConf rs ctx conf + Stage0 _ | isBoot -> copyConf rs ctx conf _ -> buildConf rs ctx conf buildConf :: [(Resource, Int)] -> Context -> FilePath -> Action () diff --git a/hadrian/src/Rules/Rts.hs b/hadrian/src/Rules/Rts.hs index 9a18a41c46..cb3026cd32 100644 --- a/hadrian/src/Rules/Rts.hs +++ b/hadrian/src/Rules/Rts.hs @@ -24,7 +24,7 @@ rtsRules = priority 3 $ do rtsLibFilePath' -- Libffi - forM_ [Stage1 ..] $ \ stage -> do + forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do let buildPath = root -/- buildDir (rtsContext stage) -- Header files diff --git a/hadrian/src/Rules/Selftest.hs b/hadrian/src/Rules/Selftest.hs index bd7e5f9544..eae902013f 100644 --- a/hadrian/src/Rules/Selftest.hs +++ b/hadrian/src/Rules/Selftest.hs @@ -62,10 +62,10 @@ testDependencies = do putBuild "==== Dependencies of the 'ghc-bin' binary" ghcDeps <- pkgDependencies ghc test $ pkgName compiler `elem` ghcDeps - stage0Deps <- contextDependencies (vanillaContext Stage0 ghc) + stage0Deps <- contextDependencies (vanillaContext stage0InTree ghc) stage1Deps <- contextDependencies (vanillaContext Stage1 ghc) stage2Deps <- contextDependencies (vanillaContext Stage2 ghc) - test $ vanillaContext Stage0 compiler `notElem` stage1Deps + test $ vanillaContext stage0InTree compiler `notElem` stage1Deps test $ vanillaContext Stage1 compiler `elem` stage1Deps test $ vanillaContext Stage2 compiler `notElem` stage1Deps test $ stage1Deps /= stage0Deps @@ -102,7 +102,7 @@ testPackages :: Action () testPackages = do putBuild "==== Check system configuration" putBuild "==== Packages, interpretInContext, configuration flags" - forM_ [Stage0 ..] $ \stage -> do + forM_ allStages $ \stage -> do pkgs <- stagePackages stage when (win32 `elem` pkgs) . test $ windowsHost when (unix `elem` pkgs) . test $ not windowsHost diff --git a/hadrian/src/Rules/SimpleTargets.hs b/hadrian/src/Rules/SimpleTargets.hs index e6c42907de..f89575fccb 100644 --- a/hadrian/src/Rules/SimpleTargets.hs +++ b/hadrian/src/Rules/SimpleTargets.hs @@ -23,7 +23,7 @@ simplePackageTargets :: Rules () simplePackageTargets = traverse_ simpleTarget targets where targets = [ (stage, target) - | stage <- [minBound..maxBound] + | stage <- allStages , target <- knownPackages ] @@ -53,10 +53,11 @@ getLibraryPath :: Stage -> Package -> Action FilePath getLibraryPath stage pkg = pkgConfFile (vanillaContext stage pkg) getProgramPath :: Stage -> Package -> Action FilePath -getProgramPath Stage0 _ = - error ("Cannot build a stage 0 executable target: " ++ - "it is the boot compiler's toolchain") -getProgramPath stage pkg = programPath (vanillaContext (pred stage) pkg) +getProgramPath stage pkg = + case stage of + (Stage0 GlobalLibs) -> error "Can't build executable in stageBoot" + (Stage0 InTreeLibs) -> programPath (vanillaContext stage0Boot pkg) + s -> programPath (vanillaContext (predStage s) pkg) -- | A phony @autocomplete@ rule that prints all valid setting keys diff --git a/hadrian/src/Rules/SourceDist.hs b/hadrian/src/Rules/SourceDist.hs index 69941d5d5f..a673fb434c 100644 --- a/hadrian/src/Rules/SourceDist.hs +++ b/hadrian/src/Rules/SourceDist.hs @@ -151,12 +151,12 @@ prepareTree dest = do -- (stage, package, input file, output file) alexHappyFiles = - [ (Stage0, compiler, "GHC/Cmm/Parser.y", "GHC/Cmm/Parser.hs") - , (Stage0, compiler, "GHC/Cmm/Lexer.x", "GHC/Cmm/Lexer.hs") - , (Stage0, compiler, "GHC/Parser.y", "GHC/Parser.hs") - , (Stage0, compiler, "GHC/Parser/Lexer.x", "GHC/Parser/Lexer.hs") - , (Stage0, compiler, "GHC/Parser/HaddockLex.x", "GHC/Parser/HaddockLex.hs") - , (Stage0, hpcBin, "HpcParser.y", "HpcParser.hs") - , (Stage0, genprimopcode, "Parser.y", "Parser.hs") - , (Stage0, genprimopcode, "Lexer.x", "Lexer.hs") + [ (stage0InTree , compiler, "GHC/Cmm/Parser.y", "GHC/Cmm/Parser.hs") + , (stage0InTree , compiler, "GHC/Cmm/Lexer.x", "GHC/Cmm/Lexer.hs") + , (stage0InTree , compiler, "GHC/Parser.y", "GHC/Parser.hs") + , (stage0InTree , compiler, "GHC/Parser/Lexer.x", "GHC/Parser/Lexer.hs") + , (stage0InTree , compiler, "GHC/Parser/HaddockLex.x", "GHC/Parser/HaddockLex.hs") + , (stage0InTree , hpcBin, "HpcParser.y", "HpcParser.hs") + , (stage0InTree , genprimopcode, "Parser.y", "Parser.hs") + , (stage0InTree , genprimopcode, "Lexer.x", "Lexer.hs") ] diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs index f12d7890b8..23b9429553 100644 --- a/hadrian/src/Rules/Test.hs +++ b/hadrian/src/Rules/Test.hs @@ -66,8 +66,8 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id - , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const Stage0) id - , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const Stage0) (filter (/= lintersCommon)) + , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id + , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] inTreeOutTree :: (Stage -> Action b) -> Action b -> Action b @@ -162,7 +162,7 @@ testRules = do ghcPath <- getCompilerPath testGhc whenJust (stageOf testGhc) $ \stg -> need . (:[]) =<< programPath (Context stg ghc vanilla) - ghcConfigProgPath <- programPath =<< programContext Stage0 ghcConfig + ghcConfigProgPath <- programPath =<< programContext stage0InTree ghcConfig cwd <- liftIO $ IO.getCurrentDirectory need [makeRelative cwd ghcPath, ghcConfigProgPath] cmd [FileStdout $ root -/- ghcConfigPath] ghcConfigProgPath [ghcPath] @@ -256,7 +256,7 @@ timeoutProgBuilder = do root <- buildRoot if windowsHost then do - prog <- programPath =<< programContext Stage0 timeout + prog <- programPath =<< programContext stage0InTree timeout copyFile prog (root -/- timeoutPath) else do python <- builderPath Python @@ -272,26 +272,26 @@ needTestsuitePackages :: Stage -> Action () needTestsuitePackages stg = do allpkgs <- packages <$> flavour -- We need the libraries of the successor stage - libpkgs <- map (Stage1,) . filter isLibrary <$> allpkgs (succ stg) + libpkgs <- map (Stage1,) . filter isLibrary <$> allpkgs (succStage stg) -- And the executables of the current stage exepkgs <- map (stg,) . filter isProgram <$> allpkgs stg -- Don't require lib:ghc or lib:cabal when testing the stage1 compiler -- This is a hack, but a major usecase for testing the stage1 compiler is -- so that we can use it even if ghc stage2 fails to build -- Unfortunately, we still need the liba - let pkgs = filter (\(_,p) -> not $ "iserv" `isInfixOf` pkgName p || ((pkgName p `elem` ["ghc", "Cabal"]) && stg == Stage0)) + let pkgs = filter (\(_,p) -> not $ "iserv" `isInfixOf` pkgName p || ((pkgName p `elem` ["ghc", "Cabal"]) && isStage0 stg)) (libpkgs ++ exepkgs ++ [ (stg,timeout) | windowsHost ]) need =<< mapM (uncurry pkgFile) pkgs cross <- flag CrossCompiling when (not cross) $ needIservBins stg root <- buildRoot -- require the shims for testing stage1 - need =<< sequence [(\f -> root -/- "stage1-test/bin" -/- takeFileName f) <$> (pkgFile Stage0 p) | (Stage0,p) <- exepkgs] + need =<< sequence [(\f -> root -/- "stage1-test/bin" -/- takeFileName f) <$> (pkgFile stage0InTree p) | (Stage0 InTreeLibs,p) <- exepkgs] -- stage 1 ghc lives under stage0/bin, -- stage 2 ghc lives under stage1/bin, etc stageOf :: String -> Maybe Stage -stageOf "stage1" = Just Stage0 +stageOf "stage1" = Just stage0InTree stageOf "stage2" = Just Stage1 stageOf "stage3" = Just Stage2 stageOf _ = Nothing @@ -305,7 +305,7 @@ needIservBins stg = do -- Only build iserv binaries if all dependencies are built the right -- way already. In particular this fixes the case of no_profiled_libs -- not working with the testsuite, see #19624 - canBuild Stage0 _ = pure Nothing + canBuild (Stage0 {}) _ = pure Nothing canBuild stg w = do contextDeps <- contextDependencies (Context stg iserv w) ws <- forM contextDeps $ \c -> diff --git a/hadrian/src/Rules/ToolArgs.hs b/hadrian/src/Rules/ToolArgs.hs index eff690cd9b..105ed8f15a 100644 --- a/hadrian/src/Rules/ToolArgs.hs +++ b/hadrian/src/Rules/ToolArgs.hs @@ -49,8 +49,8 @@ mkToolTarget es p = do -- This builds automatically generated dependencies. Not sure how to do -- this generically yet. allDeps - let fake_target = target (Context Stage0 p (if windowsHost then vanilla else dynamic)) - (Ghc ToolArgs Stage0) [] ["ignored"] + let fake_target = target (Context stage0InTree p (if windowsHost then vanilla else dynamic)) + (Ghc ToolArgs stage0InTree) [] ["ignored"] arg_list <- interpret fake_target getArgs liftIO $ putStrLn (intercalate "\n" (arg_list ++ es)) allDeps :: Action () @@ -59,14 +59,14 @@ allDeps = do -- We can't build DLLs on Windows (yet). Actually we should only -- include the dynamic way when we have a dynamic host GHC, but just -- checking for Windows seems simpler for now. - let fake_target = target (Context Stage0 compiler (if windowsHost then vanilla else dynamic)) - (Ghc ToolArgs Stage0) [] ["ignored"] + let fake_target = target (Context stage0InTree compiler (if windowsHost then vanilla else dynamic)) + (Ghc ToolArgs stage0InTree) [] ["ignored"] -- need the autogenerated files so that they are precompiled interpret fake_target Rules.Generate.compilerDependencies >>= need root <- buildRoot - let dir = buildDir (vanillaContext Stage0 compiler) + let dir = buildDir (vanillaContext stage0InTree compiler) need [ root -/- dir -/- "GHC" -/- "Settings" -/- "Config.hs" ] need [ root -/- dir -/- "GHC" -/- "Parser.hs" ] need [ root -/- dir -/- "GHC" -/- "Parser" -/- "Lexer.hs" ] @@ -114,12 +114,12 @@ dirMap = do -- configuring would build the whole GHC library which we probably -- don't want to do. mkGhc = do - let c = (Context Stage0 compiler (if windowsHost then vanilla else dynamic)) + let c = (Context stage0InTree compiler (if windowsHost then vanilla else dynamic)) cd <- readContextData c fp <- liftIO $ canonicalizePath "ghc/" return (fp, (compiler, "-ighc" : modules cd ++ otherModules cd ++ ["ghc/Main.hs"])) go p = do - let c = (Context Stage0 p (if windowsHost then vanilla else dynamic)) + let c = (Context stage0InTree p (if windowsHost then vanilla else dynamic)) -- readContextData has the effect of configuring the package so all -- dependent packages will also be built. cd <- readContextData c diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs index 82e34d8594..4486ab002b 100644 --- a/hadrian/src/Settings/Builders/Cabal.hs +++ b/hadrian/src/Settings/Builders/Cabal.hs @@ -39,7 +39,7 @@ cabalInstallArgs = builder (Cabal Install) ? do -- of the stage 2 compiler assertNoBuildRootLeak :: Args -> Args assertNoBuildRootLeak args = do - libPaths <- expr $ mapM stageLibPath [Stage0 ..] + libPaths <- expr $ mapM stageLibPath allStages xs <- args pure $ assert (not $ any (\arg -> or [libPath `isInfixOf` arg && not ("package.conf.d" `isSuffixOf` arg) | libPath <- libPaths]) xs) @@ -205,8 +205,8 @@ configureArgs cFlags' ldFlags' = do ] bootPackageConstraints :: Args -bootPackageConstraints = stage0 ? do - bootPkgs <- expr $ stagePackages Stage0 +bootPackageConstraints = (stage0InTree ==) <$> getStage ? do + bootPkgs <- expr $ stagePackages stage0InTree let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs constraints <- expr $ forM (sort pkgs) $ \pkg -> do version <- pkgVersion pkg diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs index 3804c7ecc9..7deb22f179 100644 --- a/hadrian/src/Settings/Builders/Ghc.hs +++ b/hadrian/src/Settings/Builders/Ghc.hs @@ -24,7 +24,7 @@ ghcBuilderArgs = mconcat -- config at build time. -- See Note [Genapply target as host for RTS macros]. stage <- getStage - nextStageRtsBuildDir <- expr $ rtsBuildPath $ succ stage + nextStageRtsBuildDir <- expr $ rtsBuildPath $ succStage stage let nextStageRtsBuildIncludeDir = nextStageRtsBuildDir </> "include" builder Ghc ? arg ("-I" ++ nextStageRtsBuildIncludeDir) , compileAndLinkHs, compileC, compileCxx, findHsDependencies diff --git a/hadrian/src/Settings/Builders/GhcPkg.hs b/hadrian/src/Settings/Builders/GhcPkg.hs index 752f1718da..5de76cc753 100644 --- a/hadrian/src/Settings/Builders/GhcPkg.hs +++ b/hadrian/src/Settings/Builders/GhcPkg.hs @@ -35,7 +35,7 @@ ghcPkgBuilderArgs = mconcat config <- expr $ pkgInplaceConfig context stage <- getStage pkgDb <- expr $ packageDbPath stage - mconcat [ notStage0 ? use_db pkgDb + mconcat [ notM stage0 ? use_db pkgDb , arg "update" , arg "--force" , verbosity < Verbose ? arg "-v0" diff --git a/hadrian/src/Settings/Builders/Hsc2Hs.hs b/hadrian/src/Settings/Builders/Hsc2Hs.hs index f1a44b5e87..7492f6e29a 100644 --- a/hadrian/src/Settings/Builders/Hsc2Hs.hs +++ b/hadrian/src/Settings/Builders/Hsc2Hs.hs @@ -16,10 +16,10 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do hOs <- getSetting HostOs tArch <- getSetting TargetArch tOs <- getSetting TargetOs - version <- if stage == Stage0 - then expr ghcCanonVersion - else getSetting ProjectVersionInt - tmpl <- (top -/-) <$> expr (templateHscPath Stage0) + version <- case stage of + Stage0 {} -> expr ghcCanonVersion + _ -> getSetting ProjectVersionInt + tmpl <- (top -/-) <$> expr (templateHscPath stage0Boot) mconcat [ arg $ "--cc=" ++ ccPath , arg $ "--ld=" ++ ccPath , notM isWinTarget ? notM (flag CrossCompiling) ? arg "--cross-safe" diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs index f00aab9776..22096a0838 100644 --- a/hadrian/src/Settings/Builders/Make.hs +++ b/hadrian/src/Settings/Builders/Make.hs @@ -12,7 +12,7 @@ makeBuilderArgs = do threads <- shakeThreads <$> expr getShakeOptions stage <- getStage gmpPath <- expr (gmpBuildPath stage) - libffiPaths <- forM [Stage1 ..] $ \s -> expr (libffiBuildPath s) + libffiPaths <- forM [Stage1, Stage2, Stage3 ] $ \s -> expr (libffiBuildPath s) let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads mconcat $ (builder (Make gmpPath ) ? pure ["MAKEFLAGS=-j" ++ t]) : diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs index 0e442cb9be..f6b40d4065 100644 --- a/hadrian/src/Settings/Builders/RunTest.hs +++ b/hadrian/src/Settings/Builders/RunTest.hs @@ -264,7 +264,7 @@ runTestBuilderArgs = builder Testsuite ? do , arg "-e", arg $ "config.os=" ++ show os , arg "-e", arg $ "config.arch=" ++ show arch , arg "-e", arg $ "config.platform=" ++ show platform - , arg "-e", arg $ "config.stage=" ++ show (fromEnum (C.stage ctx) + 1) + , arg "-e", arg $ "config.stage=" ++ show (stageNumber (C.stage ctx)) , arg "--config", arg $ "gs=gs" -- Use the default value as in test.mk , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg) @@ -281,6 +281,12 @@ runTestBuilderArgs = builder Testsuite ? do where emitWhenSet Nothing _ = mempty emitWhenSet (Just v) f = f v + stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot" + stageNumber (Stage0 InTreeLibs) = 1 + stageNumber Stage1 = 2 + stageNumber Stage2 = 3 + stageNumber Stage3 = 4 + -- | Command line arguments for running GHC's test script. getTestArgs :: Args getTestArgs = do diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs index 54562b8aa3..ae9ea2ce81 100644 --- a/hadrian/src/Settings/Default.hs +++ b/hadrian/src/Settings/Default.hs @@ -50,7 +50,8 @@ import Settings.Builders.Win32Tarballs -- | Packages that are built by default. You can change this in "UserSettings". defaultPackages :: Stage -> Action [Package] -defaultPackages Stage0 = stage0Packages +defaultPackages (Stage0 GlobalLibs) = stageBootPackages +defaultPackages (Stage0 InTreeLibs) = stage0Packages defaultPackages Stage1 = stage1Packages defaultPackages Stage2 = stage2Packages defaultPackages Stage3 = return [] @@ -59,19 +60,26 @@ defaultPackages Stage3 = return [] defaultBignumBackend :: String defaultBignumBackend = "gmp" +-- These packages are things needed to do the build.. so they are only built by +-- boot compiler, with global package database. By default we will only build these +-- packages in StageBoot so if you also need to distribute anything here then add +-- it to `stage0packages` or `stage1packages` as appropiate. +stageBootPackages :: Action [Package] +stageBootPackages = return [lintersCommon, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, lintNotes, hsc2hs, compareSizes, deriveConstants, genapply, genprimopcode, unlit ] + -- | Packages built in 'Stage0' by default. You can change this in "UserSettings". stage0Packages :: Action [Package] stage0Packages = do cross <- flag CrossCompiling + winTarget <- isWinTarget return $ [ binary + , bytestring , cabalSyntax , cabal - , compareSizes , compiler - , deriveConstants + , directory + , process , exceptions - , genapply - , genprimopcode , ghc , runGhc , ghcBoot @@ -85,15 +93,12 @@ stage0Packages = do , hpcBin , mtl , parsec + , time , templateHaskell , text , transformers , unlit - , lintersCommon - , lintNotes - , lintCommitMsg - , lintSubmoduleRefs - , lintWhitespace + , if winTarget then win32 else unix ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] @@ -113,10 +118,8 @@ stage1Packages = do [ libraries0 -- Build all Stage0 libraries in Stage1 , [ array , base - , bytestring , containers , deepseq - , directory , exceptions , filepath , ghc @@ -129,10 +132,8 @@ stage1Packages = do , hsc2hs , integerGmp , pretty - , process , rts , stm - , time , unlit , xhtml ] @@ -143,7 +144,6 @@ stage1Packages = do , libiserv , runGhc ] - , if winTarget then [ win32 ] else [ unix ] , when (winTarget && not cross) [ touchy -- See Note [Hadrian's ghci-wrapper package] diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs index 75c0886bce..00831012cc 100644 --- a/hadrian/src/Settings/Flavours/Development.hs +++ b/hadrian/src/Settings/Flavours/Development.hs @@ -10,12 +10,17 @@ import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. developmentFlavour :: Stage -> Flavour developmentFlavour ghcStage = defaultFlavour - { name = "devel" ++ show (fromEnum ghcStage) + { name = "devel" ++ stageString ghcStage , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs , libraryWays = pure $ Set.fromList [vanilla] , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug] , dynamicGhcPrograms = return False , ghcDebugAssertions = True } + where + stageString Stage2 = "2" + stageString Stage1 = "1" + stageString Stage3 = "3" + stageString s = error ("developmentFlavour not support for " ++ show s) developmentArgs :: Stage -> Args developmentArgs ghcStage = do @@ -27,5 +32,5 @@ developmentArgs ghcStage = do package cabal ? pure ["-O0"]] , hsLibrary = notStage0 ? arg "-dlint" , hsCompiler = mconcat [stage0 ? arg "-O2", - succ stage == ghcStage ? pure ["-O0"]] - , hsGhc = succ stage == ghcStage ? pure ["-O0"] } + stage == predStage ghcStage ? pure ["-O0"]] + , hsGhc = stage == predStage ghcStage ? pure ["-O0"] } diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs index 871e7235f8..96c09ba856 100644 --- a/hadrian/src/Settings/Packages.hs +++ b/hadrian/src/Settings/Packages.hs @@ -22,7 +22,7 @@ packageArgs = do -- Check if the bootstrap compiler has the same version as the one we -- are building. This is used to build cross-compilers - bootCross = (==) <$> ghcVersionStage Stage0 <*> ghcVersionStage Stage1 + bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1 cursesIncludeDir <- getSetting CursesIncludeDir cursesLibraryDir <- getSetting CursesLibDir diff --git a/hadrian/src/Settings/Program.hs b/hadrian/src/Settings/Program.hs index d45b265008..62d41909d3 100644 --- a/hadrian/src/Settings/Program.hs +++ b/hadrian/src/Settings/Program.hs @@ -19,6 +19,9 @@ programContext stage pkg = do where wayFor prof dyn | prof && dyn = error "programContext: profiling+dynamic not supported" - | pkg == ghc && prof && stage > Stage0 = profiling - | dyn && stage > Stage0 = dynamic + | pkg == ghc && prof && notStage0 stage = profiling + | dyn && notStage0 stage = dynamic | otherwise = vanilla + + notStage0 (Stage0 {}) = False + notStage0 _ = True diff --git a/hadrian/src/Stage.hs b/hadrian/src/Stage.hs index 8f243ff8d7..be2d123e06 100644 --- a/hadrian/src/Stage.hs +++ b/hadrian/src/Stage.hs @@ -1,14 +1,19 @@ {-# LANGUAGE LambdaCase #-} -module Stage (Stage (..), stageString) where +module Stage (Stage (..), WhichLibs(..), isStage0, stage0InTree, stage0Boot, allStages,predStage, succStage, 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 +-- * Stage0 GlobalLibs is for **executables** which are built with the boot compiler +-- and boot compiler packages. For example, this was motivated by needing to +-- build hsc2hs, a build dependency of unix with just the boot toolchain. (See #21634) +-- +-- * Stage 0 (InTreeLibs) 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 0 is called /stage 1 compiler/. Stage0 executables and libraries are +-- build against the other libraries (in-tree) built by the stage 0 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. @@ -20,17 +25,81 @@ import GHC.Generics -- 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) +data Stage = Stage0 WhichLibs | Stage1 | Stage2 | Stage3 + deriving (Show, Eq, Ord, Generic) + + +-- | See Note [Stage 0 build plans] +data WhichLibs = GlobalLibs -- ^ Build build tools against the globally installed libraries + | InTreeLibs -- ^ Build the compiler against the in-tree libraries. + deriving (Show, Eq, Ord, Generic) + +allStages :: [Stage] +allStages = [Stage0 GlobalLibs, Stage0 InTreeLibs, Stage1, Stage2, Stage3] + +stage0InTree, stage0Boot :: Stage +stage0InTree = Stage0 InTreeLibs +stage0Boot = Stage0 GlobalLibs + +isStage0 :: Stage -> Bool +isStage0 Stage0 {} = True +isStage0 _ = False + + +predStage :: Stage -> Stage +predStage Stage1 = stage0InTree +predStage Stage2 = Stage1 +predStage Stage3 = Stage2 +predStage s = error ("predStage: " ++ show s) + +succStage :: Stage -> Stage +succStage (Stage0 {}) = Stage1 +succStage Stage1 = Stage2 +succStage Stage2 = Stage3 +succStage Stage3 = error "succStage: Stage3" instance Binary Stage instance Hashable Stage instance NFData Stage +instance Binary WhichLibs +instance Hashable WhichLibs +instance NFData WhichLibs + -- | Prettyprint a 'Stage'. stageString :: Stage -> String stageString = \case - Stage0 -> "stage0" + Stage0 GlobalLibs -> "stageBoot" + Stage0 InTreeLibs -> "stage0" Stage1 -> "stage1" Stage2 -> "stage2" Stage3 -> "stage3" + +{- +Note [Stage 0 build plans] +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The Stage refers to which compiler we will use to perform the builds. + + Stage0: Build with the boot toolchain + Stage1: Build with compiler built in stage 0 + Stage2: Build with compiler built in stage 1 + +Stage 0 also has two different package databases. + + Stage0 GlobalLibs: Used for building build tool dependencies (hsc2hs, unlit, linters etc) + Mostly using the libraries from the boot compiler. + Stage0 InTreeLibs: Used for building the Stage 1 compiler (ghc executable) and all libraries + needed by that. + +The reason for this split is + +1. bytestring depends on template-haskell so we need to build bytestring with stage0 (and all + packages which depend on it). This includes unix and hence directory (which depends on unix) but + unix depends on hsc2hs (which depends on directory) and you get a loop in the build + rules if you try to build them all in the same package database. + The solution is to build hsc2hs with the global boot libraries in Stage0 GlobalLibs +2. We want to build linters and other build tools which we don't distribute in a separate + package database so they don't end up in the bindist package database. + +-} |