Put PlatformConstants into Platform

12 files changed, 49 insertions, 28 deletions

diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 0e187a97b2..1d26c7d5ee 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -551,7 +551,7 @@ funInfoArity dflags iptr
     | otherwise        = ( pc_REP_StgFunInfoExtraFwd_arity pc
                          , oFFSET_StgFunInfoExtraFwd_arity dflags )
 
-   pc = platformConstants dflags
+   pc = platformConstants platform
 
 -----------------------------------------------------------------------------
 --
diff --git a/compiler/GHC/Cmm/Type.hs b/compiler/GHC/Cmm/Type.hs
index bddc933bf1..0f2971dba2 100644
--- a/compiler/GHC/Cmm/Type.hs
+++ b/compiler/GHC/Cmm/Type.hs
@@ -326,22 +326,22 @@ data ForeignHint
 rEP_CostCentreStack_mem_alloc :: DynFlags -> CmmType
 rEP_CostCentreStack_mem_alloc dflags
     = cmmBits (widthFromBytes (pc_REP_CostCentreStack_mem_alloc pc))
-    where pc = platformConstants dflags
+    where pc = platformConstants (targetPlatform dflags)
 
 rEP_CostCentreStack_scc_count :: DynFlags -> CmmType
 rEP_CostCentreStack_scc_count dflags
     = cmmBits (widthFromBytes (pc_REP_CostCentreStack_scc_count pc))
-    where pc = platformConstants dflags
+    where pc = platformConstants (targetPlatform dflags)
 
 rEP_StgEntCounter_allocs :: DynFlags -> CmmType
 rEP_StgEntCounter_allocs dflags
     = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocs pc))
-    where pc = platformConstants dflags
+    where pc = platformConstants (targetPlatform dflags)
 
 rEP_StgEntCounter_allocd :: DynFlags -> CmmType
 rEP_StgEntCounter_allocd dflags
     = cmmBits (widthFromBytes (pc_REP_StgEntCounter_allocd pc))
-    where pc = platformConstants dflags
+    where pc = platformConstants (targetPlatform dflags)
 
 -------------------------------------------------------------------------
 {-      Note [Signed vs unsigned]
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b664f23ec8..8c41a4ca4f 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -464,7 +464,6 @@ data DynFlags = DynFlags {
   targetPlatform    :: Platform,       -- Filled in by SysTools
   toolSettings      :: {-# UNPACK #-} !ToolSettings,
   platformMisc      :: {-# UNPACK #-} !PlatformMisc,
-  platformConstants :: PlatformConstants,
   rawSettings       :: [(String, String)],
 
   llvmConfig            :: LlvmConfig,
@@ -911,7 +910,7 @@ settings dflags = Settings
   , sTargetPlatform = targetPlatform dflags
   , sToolSettings = toolSettings dflags
   , sPlatformMisc = platformMisc dflags
-  , sPlatformConstants = platformConstants dflags
+  , sPlatformConstants = platformConstants (targetPlatform dflags)
   , sRawSettings = rawSettings dflags
   }
 
@@ -1331,7 +1330,6 @@ defaultDynFlags mySettings llvmConfig =
         toolSettings = sToolSettings mySettings,
         targetPlatform = sTargetPlatform mySettings,
         platformMisc = sPlatformMisc mySettings,
-        platformConstants = sPlatformConstants mySettings,
         rawSettings = sRawSettings mySettings,
 
         -- See Note [LLVM configuration].
diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs
index 6bfc1bac5f..12ad3ce94b 100644
--- a/compiler/GHC/Settings.hs
+++ b/compiler/GHC/Settings.hs
@@ -6,7 +6,6 @@ module GHC.Settings
   , ToolSettings (..)
   , FileSettings (..)
   , GhcNameVersion (..)
-  , PlatformConstants (..)
   , Platform (..)
   , PlatformMisc (..)
   , PlatformMini (..)
@@ -158,10 +157,6 @@ data GhcNameVersion = GhcNameVersion
   , ghcNameVersion_projectVersion :: String
   }
 
--- Produced by deriveConstants
--- Provides PlatformConstants datatype
-#include "GHCConstantsHaskellType.hs"
-
 -----------------------------------------------------------------------------
 -- Accessessors from 'Settings'
 
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
index c84bf280bc..c4e47618d2 100644
--- a/compiler/GHC/Settings/IO.hs
+++ b/compiler/GHC/Settings/IO.hs
@@ -92,7 +92,7 @@ initSettings top_dir = do
   cpp_prog <- getToolSetting "Haskell CPP command"
   cpp_args_str <- getSetting "Haskell CPP flags"
 
-  platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings
+  platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings platformConstants
 
   let unreg_cc_args = if platformUnregisterised platform
                       then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"]
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)
diff --git a/libraries/ghc-boot/GHC/Platform.hs b/libraries/ghc-boot/GHC/Platform.hs
index 326b93f9fa..9191dda44f 100644
--- a/libraries/ghc-boot/GHC/Platform.hs
+++ b/libraries/ghc-boot/GHC/Platform.hs
@@ -5,6 +5,7 @@
 module GHC.Platform
    ( PlatformMini(..)
    , PlatformWordSize(..)
+   , PlatformConstants(..)
    , Platform(..)
    , platformArch
    , platformOS
@@ -39,6 +40,7 @@ where
 import Prelude -- See Note [Why do we import Prelude here?]
 import GHC.Read
 import GHC.ByteOrder (ByteOrder(..))
+import GHC.Platform.Constants
 import Data.Word
 import Data.Int
 
@@ -68,6 +70,8 @@ data Platform = Platform
       -- ^ Determines whether we will be compiling info tables that reside just
       --   before the entry code, or with an indirection to the entry code. See
       --   TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
+   , platformConstants                :: !PlatformConstants
+      -- ^ Constants such as structure offsets, type sizes, etc.
    }
    deriving (Read, Show, Eq)
 
diff --git a/libraries/ghc-boot/GHC/Settings/Platform.hs b/libraries/ghc-boot/GHC/Settings/Platform.hs
index bfe9b53dc5..95278da76e 100644
--- a/libraries/ghc-boot/GHC/Settings/Platform.hs
+++ b/libraries/ghc-boot/GHC/Settings/Platform.hs
@@ -26,8 +26,11 @@ import qualified Data.Map as Map
 -- parts of settings file
 
 getTargetPlatform
-  :: FilePath -> RawSettings -> Either String Platform
-getTargetPlatform settingsFile mySettings = do
+  :: FilePath     -- ^ Settings filepath (for error messages)
+  -> RawSettings  -- ^ Raw settings file contents
+  -> PlatformConstants -- ^ Platform constants
+  -> Either String Platform
+getTargetPlatform settingsFile mySettings constants = do
   let
     getBooleanSetting = getBooleanSetting0 settingsFile mySettings
     readSetting :: (Show a, Read a) => String -> Either String a
@@ -59,6 +62,7 @@ getTargetPlatform settingsFile mySettings = do
     , platformIsCrossCompiling = crossCompiling
     , platformLeadingUnderscore = targetLeadingUnderscore
     , platformTablesNextToCode  = tablesNextToCode
+    , platformConstants = constants
     }
 
 -----------------------------------------------------------------------------
diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in
index bf68363827..aed65d8f0a 100644
--- a/libraries/ghc-boot/ghc-boot.cabal.in
+++ b/libraries/ghc-boot/ghc-boot.cabal.in
@@ -45,6 +45,7 @@ Library
             GHC.HandleEncoding
             GHC.Platform
             GHC.Platform.Host
+            GHC.Platform.Constants
             GHC.Settings.Platform
             GHC.Settings.Utils
             GHC.UniqueSubdir
@@ -54,6 +55,7 @@ Library
     -- autogen-modules:
     --         GHC.Version
     --         GHC.Platform.Host
+    --         GHC.Platform.Constants
 
     build-depends: base       >= 4.7 && < 4.16,
                    binary     == 0.8.*,
diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs
index 1867d824b6..0b6247cf97 100644
--- a/utils/deriveConstants/Main.hs
+++ b/utils/deriveConstants/Main.hs
@@ -873,8 +873,10 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram
 writeHaskellType :: FilePath -> [What Fst] -> IO ()
 writeHaskellType fn ws = writeFile fn xs
     where xs = unlines [header, body, footer]
-          header = "data PlatformConstants = PlatformConstants {"
-          footer = "  } deriving Read"
+          header = "module GHC.Platform.Constants where\n\n\
+                   \import Prelude\n\n\
+                   \data PlatformConstants = PlatformConstants {"
+          footer = "  } deriving (Show,Read,Eq)"
           body = intercalate ",\n" (concatMap doWhat ws)
 
           doWhat (GetClosureSize name _) = ["      pc_" ++ name ++ " :: Int"]
@@ -909,16 +911,17 @@ writeHaskellWrappers :: FilePath -> [What Fst] -> IO ()
 writeHaskellWrappers fn ws = writeFile fn xs
     where xs = unlines body
           body = concatMap doWhat ws
+          constants = " (platformConstants (targetPlatform dflags))"
           doWhat (GetFieldType {}) = []
           doWhat (GetClosureSize {}) = []
           doWhat (GetWord name _) = [haskellise name ++ " :: DynFlags -> Int",
-                                    haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
+                                    haskellise name ++ " dflags = pc_" ++ name ++ constants]
           doWhat (GetInt name _) = [haskellise name ++ " :: DynFlags -> Int",
-                                   haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
+                                   haskellise name ++ " dflags = pc_" ++ name ++ constants]
           doWhat (GetNatural name _) = [haskellise name ++ " :: DynFlags -> Integer",
-                                        haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
+                                        haskellise name ++ " dflags = pc_" ++ name ++ constants]
           doWhat (GetBool name _) = [haskellise name ++ " :: DynFlags -> Bool",
-                                     haskellise name ++ " dflags = pc_" ++ name ++ " (platformConstants dflags)"]
+                                     haskellise name ++ " dflags = pc_" ++ name ++ constants]
           doWhat (StructFieldMacro {}) = []
           doWhat (ClosureFieldMacro {}) = []
           doWhat (ClosurePayloadMacro {}) = []
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 37fd5ba566..91637f5fab 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -643,6 +643,7 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
         Right appdir -> do
           -- See Note [Settings File] about this file, and why we need GHC to share it with us.
           let settingsFile = top_dir </> "settings"
+          let constantsFile = top_dir </> "platformConstants"
           exists_settings_file <- doesFileExist settingsFile
           targetPlatformMini <- case exists_settings_file of
             False -> do
@@ -656,7 +657,11 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do
                 -- It's excusable to not have a settings file (for now at
                 -- least) but completely inexcusable to have a malformed one.
                 Nothing -> die $ "Can't parse settings file " ++ show settingsFile
-              case getTargetPlatform settingsFile mySettings of
+              constantsStr <- readFile constantsFile
+              constants <- case maybeReadFuzzy constantsStr of
+                Just s  -> pure s
+                Nothing -> die $ "Can't parse platform constants file " ++ show constantsFile
+              case getTargetPlatform settingsFile mySettings constants of
                 Right platform -> pure $ platformMini platform
                 Left e -> die e
           let subdir = uniqueSubdir targetPlatformMini