From 8c32f2c931d68e1f847cfefb8f4d514886217873 Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Sat, 26 Dec 2015 03:39:41 +0000 Subject: [PATCH] Generate includes/ghcplatform.h --- shaking-up-ghc.cabal | 4 +- src/Rules/Generate.hs | 8 ++- .../{PlatformH.hs => GhcBootPlatformH.hs} | 8 +-- src/Rules/Generators/GhcPlatformH.hs | 55 +++++++++++++++++++ 4 files changed, 67 insertions(+), 8 deletions(-) rename src/Rules/Generators/{PlatformH.hs => GhcBootPlatformH.hs} (91%) create mode 100644 src/Rules/Generators/GhcPlatformH.hs diff --git a/shaking-up-ghc.cabal b/shaking-up-ghc.cabal index d2333272a6..1e0fbbf1ce 100644 --- a/shaking-up-ghc.cabal +++ b/shaking-up-ghc.cabal @@ -43,8 +43,10 @@ executable ghc-shake , Rules.Documentation , Rules.Generate , Rules.Generators.ConfigHs + , Rules.Generators.GhcAutoconfH + , Rules.Generators.GhcBootPlatformH + , Rules.Generators.GhcPlatformH , Rules.Generators.VersionHs - , Rules.Generators.PlatformH , Rules.Library , Rules.Oracles , Rules.Package diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index 8f60dd0f16..f9c1e0b85c 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -4,8 +4,9 @@ import Expression import GHC import Rules.Generators.ConfigHs import Rules.Generators.GhcAutoconfH +import Rules.Generators.GhcBootPlatformH +import Rules.Generators.GhcPlatformH import Rules.Generators.VersionHs -import Rules.Generators.PlatformH import Oracles.ModuleFiles import Rules.Actions import Rules.Resources (Resources) @@ -56,12 +57,12 @@ generatePackageCode _ target @ (PartialTarget stage pkg) = whenM (doesFileExist srcBoot) $ copyFileChanged srcBoot $ file -<.> "hs-boot" + -- TODO: needing platformH is ugly and fragile when (pkg == compiler) $ primopsTxt %> \file -> do need [platformH, primopsSource] build $ fullTarget target HsCpp [primopsSource] [file] -- TODO: why different folders for generated files? - -- TODO: needing platformH is ugly and fragile fmap (buildPath -/-) [ "GHC/PrimopWrappers.hs" , "autogen/GHC/Prim.hs" @@ -77,7 +78,7 @@ generatePackageCode _ target @ (PartialTarget stage pkg) = file <~ generateVersionHs when (pkg == compiler) $ platformH %> \file -> do - file <~ generatePlatformH + file <~ generateGhcBootPlatformH when (pkg == runghc) $ buildPath -/- "Main.hs" %> \file -> do copyFileChanged (pkgPath pkg -/- "runghc.hs") file @@ -86,6 +87,7 @@ generatePackageCode _ target @ (PartialTarget stage pkg) = generateRules :: Rules () generateRules = do "includes/ghcautoconf.h" <~ generateGhcAutoconfH + "includes/ghcplatform.h" <~ generateGhcPlatformH where file <~ gen = file %> \out -> generate out fakeTarget gen diff --git a/src/Rules/Generators/PlatformH.hs b/src/Rules/Generators/GhcBootPlatformH.hs similarity index 91% rename from src/Rules/Generators/PlatformH.hs rename to src/Rules/Generators/GhcBootPlatformH.hs index cc29a1bd97..93b953b8f8 100644 --- a/src/Rules/Generators/PlatformH.hs +++ b/src/Rules/Generators/GhcBootPlatformH.hs @@ -1,11 +1,11 @@ -module Rules.Generators.PlatformH (generatePlatformH) where +module Rules.Generators.GhcBootPlatformH (generateGhcBootPlatformH) where import Expression import Oracles -generatePlatformH :: Expr String -generatePlatformH = do - lift $ need [sourcePath -/- "Rules/Generators/PlatformH.hs"] +generateGhcBootPlatformH :: Expr String +generateGhcBootPlatformH = do + lift $ need [sourcePath -/- "Rules/Generators/GhcBootPlatformH.hs"] stage <- getStage let cppify = replaceEq '-' '_' . replaceEq '.' '_' chooseSetting x y = getSetting $ if stage == Stage0 then x else y diff --git a/src/Rules/Generators/GhcPlatformH.hs b/src/Rules/Generators/GhcPlatformH.hs new file mode 100644 index 0000000000..2bdf5d4b72 --- /dev/null +++ b/src/Rules/Generators/GhcPlatformH.hs @@ -0,0 +1,55 @@ +module Rules.Generators.GhcPlatformH (generateGhcPlatformH) where + +import Expression +import Oracles + +generateGhcPlatformH :: Expr String +generateGhcPlatformH = do + lift $ need [sourcePath -/- "Rules/Generators/GhcPlatformH.hs"] + let cppify = replaceEq '-' '_' . replaceEq '.' '_' + hostPlatform <- getSetting HostPlatform + hostArch <- getSetting HostArch + hostOs <- getSetting HostOs + hostVendor <- getSetting HostVendor + targetPlatform <- getSetting TargetPlatform + targetArch <- getSetting TargetArch + targetOs <- getSetting TargetOs + targetVendor <- getSetting TargetVendor + ghcUnreg <- getFlag GhcUnregisterised + return . unlines $ + [ "#ifndef __GHCPLATFORM_H__" + , "#define __GHCPLATFORM_H__" + , "" + , "#define BuildPlatform_TYPE " ++ cppify hostPlatform + , "#define HostPlatform_TYPE " ++ cppify targetPlatform + , "" + , "#define " ++ cppify hostPlatform ++ "_BUILD 1" + , "#define " ++ cppify targetPlatform ++ "_HOST 1" + , "" + , "#define " ++ hostArch ++ "_BUILD_ARCH 1" + , "#define " ++ targetArch ++ "_HOST_ARCH 1" + , "#define BUILD_ARCH " ++ quote hostArch + , "#define HOST_ARCH " ++ quote targetArch + , "" + , "#define " ++ hostOs ++ "_BUILD_OS 1" + , "#define " ++ targetOs ++ "_HOST_OS 1" + , "#define BUILD_OS " ++ quote hostOs + , "#define HOST_OS " ++ quote targetOs + , "" + , "#define " ++ hostVendor ++ "_BUILD_VENDOR 1" + , "#define " ++ targetVendor ++ "_HOST_VENDOR 1" + , "#define BUILD_VENDOR " ++ quote hostVendor + , "#define HOST_VENDOR " ++ quote targetVendor + , "" + , "/* These TARGET macros are for backwards compatibility... DO NOT USE! */" + , "#define TargetPlatform_TYPE " ++ cppify targetPlatform + , "#define " ++ cppify targetPlatform ++ "_TARGET 1" + , "#define " ++ targetArch ++ "_TARGET_ARCH 1" + , "#define TARGET_ARCH " ++ quote targetArch + , "#define " ++ targetOs ++ "_TARGET_OS 1" + , "#define TARGET_OS " ++ quote targetOs + , "#define " ++ targetVendor ++ "_TARGET_VENDOR 1" ] + ++ + [ "#define UnregisterisedCompiler 1" | ghcUnreg ] + ++ + [ "\n#endif /* __GHCPLATFORM_H__ */" ]