summaryrefslogtreecommitdiff
path: root/hadrian/src/Rules
diff options
context:
space:
mode:
Diffstat (limited to 'hadrian/src/Rules')
-rw-r--r--hadrian/src/Rules/BinaryDist.hs11
-rw-r--r--hadrian/src/Rules/Clean.hs2
-rw-r--r--hadrian/src/Rules/Generate.hs23
-rw-r--r--hadrian/src/Rules/Libffi.hs2
-rw-r--r--hadrian/src/Rules/Program.hs18
-rw-r--r--hadrian/src/Rules/Register.hs5
-rw-r--r--hadrian/src/Rules/Rts.hs2
-rw-r--r--hadrian/src/Rules/Selftest.hs6
-rw-r--r--hadrian/src/Rules/SimpleTargets.hs11
-rw-r--r--hadrian/src/Rules/SourceDist.hs16
-rw-r--r--hadrian/src/Rules/Test.hs18
-rw-r--r--hadrian/src/Rules/ToolArgs.hs14
12 files changed, 63 insertions, 65 deletions
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
View Lorry Controller Status