[commit: ghc] wip/nfs-locking: Generate includes/ghcplatform.h (8c32f2c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/8c32f2c931d68e1f847cfefb8f4d514886217873/ghc

>---------------------------------------------------------------

commit 8c32f2c931d68e1f847cfefb8f4d514886217873
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Dec 26 03:39:41 2015 +0000

    Generate includes/ghcplatform.h


>---------------------------------------------------------------

8c32f2c931d68e1f847cfefb8f4d514886217873
 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(-)

diff --git a/shaking-up-ghc.cabal b/shaking-up-ghc.cabal
index d233327..1e0fbbf 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 8f60dd0..f9c1e0b 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 cc29a1b..93b953b 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 0000000..2bdf5d4
--- /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__ */" ]