Factor out a smaller part of Platform for host fallback

5 files changed, 58 insertions, 17 deletions

diff --git a/libraries/ghc-boot/GHC/Platform.hs b/libraries/ghc-boot/GHC/Platform.hs
index 7eec31a9fe..8e4ae5f4b9 100644
--- a/libraries/ghc-boot/GHC/Platform.hs
+++ b/libraries/ghc-boot/GHC/Platform.hs
@@ -3,8 +3,9 @@
 -- | A description of the platform we're compiling for.
 --
 module GHC.Platform (
-        Platform(..),
+        PlatformMini(..),
         PlatformWordSize(..),
+        Platform(..), platformArch, platformOS,
         Arch(..),
         OS(..),
         ArmISA(..),
@@ -33,12 +34,21 @@ where
 import Prelude -- See Note [Why do we import Prelude here?]
 import GHC.Read
 
+-- | Contains the bare-bones arch and os information. This isn't enough for
+-- code gen, but useful for tasks where we can fall back upon the host
+-- platform, as this is all we know about the host platform.
+data PlatformMini
+  = PlatformMini
+    { platformMini_arch :: Arch
+    , platformMini_os :: OS
+    }
+    deriving (Read, Show, Eq)
+
 -- | Contains enough information for the native code generator to emit
 --      code for this platform.
 data Platform
         = Platform {
-              platformArch                     :: Arch,
-              platformOS                       :: OS,
+              platformMini                     :: PlatformMini,
               -- Word size in bytes (i.e. normally 4 or 8,
               -- for 32bit and 64bit platforms respectively)
               platformWordSize                 :: PlatformWordSize,
@@ -76,6 +86,14 @@ platformWordSizeInBytes p =
 platformWordSizeInBits :: Platform -> Int
 platformWordSizeInBits p = platformWordSizeInBytes p * 8
 
+-- | Legacy accessor
+platformArch :: Platform -> Arch
+platformArch = platformMini_arch . platformMini
+
+-- | Legacy accessor
+platformOS :: Platform -> OS
+platformOS = platformMini_os . platformMini
+
 -- | Architectures that the native code generator knows about.
 --      TODO: It might be nice to extend these constructors with information
 --      about what instruction set extensions an architecture might support.
diff --git a/libraries/ghc-boot/GHC/Settings.hs b/libraries/ghc-boot/GHC/Settings.hs
index a112c5d739..96680dc58e 100644
--- a/libraries/ghc-boot/GHC/Settings.hs
+++ b/libraries/ghc-boot/GHC/Settings.hs
@@ -43,8 +43,10 @@ getTargetPlatform settingsFile mySettings = do
   crossCompiling <- getBooleanSetting "cross compiling"
 
   pure $ Platform
-    { platformArch = targetArch
-    , platformOS   = targetOS
+    { platformMini = PlatformMini
+      { platformMini_arch = targetArch
+      , platformMini_os = targetOS
+      }
     , platformWordSize = targetWordSize
     , platformUnregisterised = targetUnregisterised
     , platformHasGnuNonexecStack = targetHasGnuNonexecStack
diff --git a/libraries/ghc-boot/GHC/UniqueSubdir.hs b/libraries/ghc-boot/GHC/UniqueSubdir.hs
index 49ae05e526..b59fdc43ce 100644
--- a/libraries/ghc-boot/GHC/UniqueSubdir.hs
+++ b/libraries/ghc-boot/GHC/UniqueSubdir.hs
@@ -1,6 +1,5 @@
 module GHC.UniqueSubdir
   ( uniqueSubdir
-  , uniqueSubdir0
   ) where
 
 import Prelude -- See Note [Why do we import Prelude here?]
@@ -13,18 +12,13 @@ import GHC.Version (cProjectVersion)
 -- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when
 -- constructing platform-version-dependent files that need to co-exist.
 --
-uniqueSubdir :: Platform -> FilePath
-uniqueSubdir platform = uniqueSubdir0
-  (stringEncodeArch $ platformArch platform)
-  (stringEncodeOS $ platformOS platform)
-
--- | 'ghc-pkg' falls back on the host platform if the settings file is missing,
+-- 'ghc-pkg' falls back on the host platform if the settings file is missing,
 -- and so needs this since we don't have information about the host platform in
--- as much detail as 'Platform'.
-uniqueSubdir0 :: String -> String -> FilePath
-uniqueSubdir0 arch os = intercalate "-"
-  [ arch
-  , os
+-- as much detail as 'Platform', so we use 'PlatformMini' instead.
+uniqueSubdir :: PlatformMini -> FilePath
+uniqueSubdir archOs = intercalate "-"
+  [ stringEncodeArch $ platformMini_arch archOs
+  , stringEncodeOS $ platformMini_os archOs
   , cProjectVersion
   ]
   -- NB: This functionality is reimplemented in Cabal, so if you
diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in
index aed75b0c8a..f986810b6b 100644
--- a/libraries/ghc-boot/ghc-boot.cabal.in
+++ b/libraries/ghc-boot/ghc-boot.cabal.in
@@ -44,6 +44,7 @@ Library
             GHC.ForeignSrcLang
             GHC.HandleEncoding
             GHC.Platform
+            GHC.Platform.Host
             GHC.Settings
             GHC.UniqueSubdir
             GHC.Version
@@ -51,6 +52,7 @@ Library
     -- but done by Hadrian
     -- autogen-modules:
     --         GHC.Version
+    --         GHC.Platform.Host
 
     build-depends: base       >= 4.7 && < 4.14,
                    binary     == 0.8.*,
diff --git a/libraries/ghc-boot/ghc.mk b/libraries/ghc-boot/ghc.mk
index 29c5376560..9c5d695d8c 100644
--- a/libraries/ghc-boot/ghc.mk
+++ b/libraries/ghc-boot/ghc.mk
@@ -34,3 +34,28 @@ libraries/ghc-boot/dist-boot/package-data.mk: \
 	libraries/ghc-boot/dist-boot/build/GHC/Version.hs
 libraries/ghc-boot/dist-install/package-data.mk: \
 	libraries/ghc-boot/dist-install/build/GHC/Version.hs
+
+libraries/ghc-boot/dist-boot/build/GHC/Platform/Host.hs \
+libraries/ghc-boot/dist-install/build/GHC/Platform/Host.hs: mk/project.mk | $$(dir $$@)/.
+	$(call removeFiles,$@)
+	@echo "module GHC.Platform.Host where"                              >> $@
+	@echo                                                               >> $@
+	@echo 'import GHC.Platform'                                         >> $@
+	@echo                                                               >> $@
+	@echo 'cHostPlatformArch   :: Arch'                                 >> $@
+	@echo 'cHostPlatformArch   = $(HaskellHostArch)'                    >> $@
+	@echo                                                               >> $@
+	@echo 'cHostPlatformOS     :: OS'                                   >> $@
+	@echo 'cHostPlatformOS     = $(HaskellHostOs)'                      >> $@
+	@echo                                                               >> $@
+	@echo 'cHostPlatformMini :: PlatformMini'                           >> $@
+	@echo 'cHostPlatformMini = PlatformMini'                            >> $@
+	@echo '  { platformMini_arch = cHostPlatformArch'                   >> $@
+	@echo '  , platformMini_os = cHostPlatformOS'                       >> $@
+	@echo '  }'                                                         >> $@
+	@echo done.
+
+libraries/ghc-boot/dist-boot/package-data.mk: \
+	libraries/ghc-boot/dist-boot/build/GHC/Platform/Host.hs
+libraries/ghc-boot/dist-install/package-data.mk: \
+	libraries/ghc-boot/dist-install/build/GHC/Platform/Host.hs