diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-07-07 13:16:47 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-07-25 00:45:08 -0400 |
| commit | 6333d7391068d8029eed3e8eff019b9e2c104c7b (patch) | |
| tree | ed9c42bf6df586a976db83ff448b3efd16ef9764 /hadrian | |
| parent | 342a01af624840ba94f22256079ff4f3cee09ca2 (diff) | |
| download | haskell-6333d7391068d8029eed3e8eff019b9e2c104c7b.tar.gz | |
Put PlatformConstants into Platform
Diffstat (limited to 'hadrian')
| -rw-r--r-- | hadrian/src/Rules/Generate.hs | 6 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/DeriveConstants.hs | 14 |
2 files changed, 15 insertions, 5 deletions
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs index e2097d8d79..98ea2bd353 100644 --- a/hadrian/src/Rules/Generate.hs +++ b/hadrian/src/Rules/Generate.hs @@ -119,6 +119,7 @@ generatePackageCode context@(Context stage pkg _) = do when (pkg == ghcBoot) $ do root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs + root -/- "**" -/- dir -/- "GHC/Platform/Constants.hs" %> genPlatformConstantsType context when (pkg == compiler) $ do root -/- primopsTxt stage %> \file -> do @@ -145,6 +146,11 @@ genPrimopCode context@(Context stage _pkg _) file = do need [root -/- primopsTxt stage] build $ target context GenPrimopCode [root -/- primopsTxt stage] [file] +genPlatformConstantsType :: Context -> FilePath -> Action () +genPlatformConstantsType context file = do + withTempDir $ \tmpdir -> + build $ target context DeriveConstants [] [file,"--gen-haskell-type",tmpdir] + copyRules :: Rules () copyRules = do root <- buildRootRules diff --git a/hadrian/src/Settings/Builders/DeriveConstants.hs b/hadrian/src/Settings/Builders/DeriveConstants.hs index a8fcf37d0b..de548b41ff 100644 --- a/hadrian/src/Settings/Builders/DeriveConstants.hs +++ b/hadrian/src/Settings/Builders/DeriveConstants.hs @@ -19,12 +19,16 @@ deriveConstantsBuilderArgs :: Args deriveConstantsBuilderArgs = builder DeriveConstants ? do cFlags <- includeCcArgs outs <- getOutputs - let (outputFile, tempDir) = case outs of - [a, b] -> (a, b) - _ -> error $ "DeriveConstants: expected two outputs, got " ++ show outs + let (outputFile, mode, tempDir) = case outs of + [ofile, mode, tmpdir] -> (ofile,mode,tmpdir) + [ofile, tmpdir] + | Just mode <- lookup (takeFileName ofile) deriveConstantsPairs + -> (ofile, mode, tmpdir) + | otherwise + -> error $ "DeriveConstants: invalid output file, got " ++ show (takeFileName ofile) + _ -> error $ "DeriveConstants: unexpected outputs, got " ++ show outs mconcat - [ mconcat $ flip fmap deriveConstantsPairs $ \(fileName, flag) -> - output ("//" ++ fileName) ? arg flag + [ arg mode , arg "-o", arg outputFile , arg "--tmpdir", arg tempDir , arg "--gcc-program", arg =<< getBuilderPath (Cc CompileC Stage1) |