Get rid of HADRIAN_SETTINGS

.github/workflows/reusable-release.yml

@@ -25,6 +25,7 @@ on:
         default: true
 
 env:
+  GIT_COMMIT_ID: ${{ github.sha }}
   # toolchain
   GHC_VERSION: ${{ inputs.ghc }}
   GHC_TARGETS: ${{ inputs.ghc_targets }}

Makefile

@@ -73,7 +73,6 @@
 # - [ ] Where do we get the version number from? The configure script _does_ contain
 #       one and sets it, but should it come from the last release tag this branch is
 #       contains?
-# - [ ] HADRIAN_SETTINGS needs to be removed.
 # - [ ] The hadrian folder needs to be removed.
 # - [ ] All sublibs should be SRPs in the relevant cabal.project files. No more
 #       submodules.
@@ -191,18 +190,6 @@ TARGET_TRIPLE   = $(call GHC_INFO,Target platform)
 GHC_LIBDIR      = $(call GHC_INFO,LibDir)
 GIT_COMMIT_ID  := $(shell git rev-parse HEAD)
 
-define HADRIAN_SETTINGS
-[ ("hostPlatformArch",    "$(TARGET_ARCH)") \
-, ("hostPlatformOS",      "$(TARGET_OS)") \
-, ("cProjectGitCommitId", "$(GIT_COMMIT_ID)") \
-, ("cProjectVersion",     "9.14") \
-, ("cProjectVersionInt",  "914") \
-, ("cProjectPatchLevel",  "0") \
-, ("cProjectPatchLevel1", "0") \
-, ("cProjectPatchLevel2", "0") \
-]
-endef
-
 # Handle CPUS and THREADS
 CPUS_DETECT_SCRIPT := ./mk/detect-cpu-count.sh
 CPUS := $(shell if [ -x $(CPUS_DETECT_SCRIPT) ]; then $(CPUS_DETECT_SCRIPT); else echo 2; fi)
@@ -631,7 +618,7 @@ $(addprefix _build/stage1/bin/,$(STAGE1_EXECUTABLES)) &: $(CABAL) $(CONFIGURE_SC
 	@echo "::group::Building stage1 executables ($(STAGE1_EXECUTABLES))..."
 	# Force cabal to replan
 	rm -rf _build/stage1/cache
-	HADRIAN_SETTINGS='$(HADRIAN_SETTINGS)' $(CABAL_BUILD) $(STAGE1_TARGETS)
+	$(CABAL_BUILD) $(STAGE1_TARGETS)
 	@echo "::endgroup::"
 
 _build/stage1/lib/settings: _build/stage1/bin/ghc-toolchain-bin$(EXE_EXT)
@@ -678,7 +665,7 @@ $(addprefix _build/stage2/bin/,$(STAGE2_EXECUTABLES)) &: $(CABAL) stage1 cabal.p
 	@echo "::group::Building stage2 executables ($(STAGE2_EXECUTABLES))..."
 	# Force cabal to replan
 	rm -rf _build/stage2/cache
-	GHC=$(GHC) HADRIAN_SETTINGS='$(HADRIAN_SETTINGS)' \
+	GHC=$(GHC) \
 		PATH='$(PWD)/_build/stage1/bin:$(PATH)' \
 		$(CABAL_BUILD) --ghc-options="-ghcversion-file=$(abspath ./rts/include/ghcversion.h)" -W $(GHC0) $(STAGE2_TARGETS)
 	@echo "::endgroup::"
@@ -691,7 +678,7 @@ stage2-rts: $(CABAL) stage1 cabal.project.stage2
 	@echo "::group::Building stage2 RTSes..."
 	# Force cabal to replan
 	rm -rf _build/stage2/cache
-	GHC=$(GHC) HADRIAN_SETTINGS='$(HADRIAN_SETTINGS)' \
+	GHC=$(GHC) \
 		PATH='$(PWD)/_build/stage1/bin:$(PATH)' \
 		$(CABAL_BUILD) --ghc-options="-ghcversion-file=$(abspath ./rts/include/ghcversion.h)" -W $(GHC0) $(STAGE2_UTIL_RTS)
 	@echo "::endgroup::"
@@ -706,7 +693,7 @@ $(addprefix _build/stage2/bin/,$(STAGE2_UTIL_EXECUTABLES)) &: $(CABAL) stage1 ca
 	@echo "::group::Building stage2 utilities ($(STAGE2_UTIL_EXECUTABLES))..."
 	# Force cabal to replan
 	rm -rf _build/stage2/cache
-	GHC=$(GHC) HADRIAN_SETTINGS='$(HADRIAN_SETTINGS)' \
+	GHC=$(GHC) \
 		PATH='$(PWD)/_build/stage1/bin:$(PATH)' \
 		$(CABAL_BUILD) --ghc-options="-ghcversion-file=$(abspath ./rts/include/ghcversion.h)" -W $(GHC0) $(STAGE2_UTIL_TARGETS)
 	@echo "::endgroup::"
@@ -781,7 +768,7 @@ _build/stage3/lib/targets/%/lib/ghc-interp.js:
 
 # $1 = TIPLET
 define build_cross
-	LD_LIBRARY_PATH=$(LD_LIBRARY_PATH) GHC=$(GHC) HADRIAN_SETTINGS='$(call HADRIAN_SETTINGS)' \
+	LD_LIBRARY_PATH=$(LD_LIBRARY_PATH) GHC=$(GHC) \
 		PATH=$(PWD)/_build/stage2/bin:$(PWD)/_build/stage3/bin:$(PATH) \
 		$(CABAL_BUILD) -W $(GHC2) --happy-options="--template=$(abspath _build/stage2/src/happy-lib-2.1.5/data/)" --with-hsc2hs=$1-hsc2hs --hsc2hs-options='-x' --configure-option='--host=$1' \
 		$(foreach lib,$(CROSS_EXTRA_LIB_DIRS),--extra-lib-dirs=$(lib)) \

libraries/ghc-boot/GHC/Version.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE CPP #-}
+module GHC.Version where
+
+#ifndef GIT_COMMIT_ID
+#define GIT_COMMIT_ID 000000000000000000000000000000000000000
+#endif
+
+import PackageInfo_ghc_boot (version)
+import Data.List ((!?))
+import Data.Maybe (fromMaybe)
+import Data.Version (showVersion, versionBranch)
+
+import Prelude -- See Note [Why do we import Prelude here?]
+
+cProjectGitCommitId   :: String
+cProjectGitCommitId   = "GIT_COMMIT_ID"
+
+cProjectVersion       :: String
+cProjectVersion       = showVersion version
+
+cProjectVersionInt    :: String
+cProjectVersionInt    = concatMap show (versionBranch version)
+
+cProjectPatchLevel    :: String
+cProjectPatchLevel    = case (versionBranch version !? 2, versionBranch version !? 3) of
+                          (Just pl1, Just pl2) -> show pl1 ++ show pl2
+                          (Just pl1, Nothing)  -> show pl1
+                          _                    -> "0"
+
+cProjectPatchLevel1   :: String
+cProjectPatchLevel1   = show $ fromMaybe 0 (versionBranch version !? 2)
+
+cProjectPatchLevel2   :: String
+cProjectPatchLevel2   = show $ fromMaybe 0 (versionBranch version !? 3)

libraries/ghc-boot/Setup.hs

@@ -21,109 +21,108 @@ import System.Environment
 import Control.Monad
 import Data.Char
 import GHC.ResponseFile
+import Distribution.System (Platform(..))
 
 main :: IO ()
 main = defaultMainWithHooks ghcHooks
   where
     ghcHooks = simpleUserHooks
-      { postConf = \args cfg pd lbi -> do
+      { confHook = \(gpd, hbi) cfg -> do
+          let verbosity = fromFlagOrDefault minBound (configVerbosity cfg)
+          lbi <- confHook simpleUserHooks (gpd, hbi) cfg
+          gitCommitId <- lookupEnv "GIT_COMMIT_ID" >>= \case
+            Just str -> return str
+            Nothing -> do
+              (git, progdb) <- requireProgram verbosity (simpleProgram "git") defaultProgramDb
+              getProgramOutput verbosity git ["rev-parse", "HEAD"]
+          info verbosity $ "Git Commit Id = " ++ gitCommitId
+          let cfs = configFlags lbi
+              cPa = configProgramArgs cfs ++ [("ghc", ["-D GIT_COMMIT_ID=" ++ gitCommitId])]
+          return lbi { configFlags = cfs { configProgramArgs = cPa } }
+
+      , postConf = \args cfg pd lbi -> do
           let verbosity = fromFlagOrDefault minBound (configVerbosity cfg)
           ghcAutogen verbosity lbi
           postConf simpleUserHooks args cfg pd lbi
       }
 
 ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
-ghcAutogen verbosity lbi@LocalBuildInfo{..} = do
+ghcAutogen verbosity lbi@LocalBuildInfo {hostPlatform, pkgDescrFile} = do
 #if MIN_VERSION_Cabal(3,14,0)
   let fromSymPath = interpretSymbolicPathLBI lbi
 #else
   let fromSymPath = id
 #endif
 
   -- Get compiler/ root directory from the cabal file
-  let Just compilerRoot = (takeDirectory . fromSymPath) <$> pkgDescrFile
+  let Just compilerRoot = takeDirectory . fromSymPath <$> pkgDescrFile
 
   let platformHostFile = "GHC/Platform/Host.hs"
       platformHostPath = fromSymPath (autogenPackageModulesDir lbi) </> platformHostFile
-      ghcVersionFile = "GHC/Version.hs"
-      ghcVersionPath = fromSymPath (autogenPackageModulesDir lbi) </> ghcVersionFile
-
-  -- Get compiler settings
-  settings <- lookupEnv "HADRIAN_SETTINGS" >>= \case
-    Just settings -> pure $ Left $ read settings
-    Nothing -> do
-      (ghc,withPrograms) <- requireProgram normal ghcProgram withPrograms
-      Right . read <$> getProgramOutput normal ghc ["--info"]
-
   -- Write GHC.Platform.Host
   createDirectoryIfMissingVerbose verbosity True (takeDirectory platformHostPath)
-  rewriteFileEx verbosity platformHostPath (generatePlatformHostHs settings)
 
-  -- Write GHC.Version
-  createDirectoryIfMissingVerbose verbosity True (takeDirectory ghcVersionPath)
-  rewriteFileEx verbosity ghcVersionPath (generateVersionHs settings)
+  -- hostPlatform is listed in LocalBuildInfo as "the platform we are building for"
+  let Platform arch os = hostPlatform
 
--- | Takes either a list of hadrian generated settings, or a list of settings from ghc --info,
--- and keys in both lists, and looks up the value in the appropriate list
-getSetting :: Either [(String,String)] [(String,String)] -> String -> String -> Either String String
-getSetting settings kh kr = case settings of
-  Left settings -> go settings kh
-  Right settings -> go settings kr
-  where
-    go settings k =  case lookup k settings of
-      Nothing -> Left (show k ++ " not found in settings: " ++ show settings)
-      Just v -> Right v
-
-generatePlatformHostHs :: Either [(String,String)] [(String,String)] -> String
-generatePlatformHostHs settings = either error id $ do
-    let getSetting' = getSetting settings
-    cHostPlatformArch <- getSetting' "hostPlatformArch" "target arch"
-    cHostPlatformOS   <- getSetting' "hostPlatformOS"   "target os"
-    return $ unlines
+  rewriteFileEx verbosity platformHostPath $
+    unlines
         [ "module GHC.Platform.Host where"
         , ""
         , "import GHC.Platform.ArchOS"
+        , "import Distribution.System hiding (Arch, OS)"
         , ""
         , "hostPlatformArch :: Arch"
-        , "hostPlatformArch = " ++ cHostPlatformArch
+        , "hostPlatformArch = toArch " ++ show arch
         , ""
         , "hostPlatformOS   :: OS"
-        , "hostPlatformOS   = " ++ cHostPlatformOS
+        , "hostPlatformOS   = toOS " ++ show os
         , ""
         , "hostPlatformArchOS :: ArchOS"
         , "hostPlatformArchOS = ArchOS hostPlatformArch hostPlatformOS"
-        ]
-
-generateVersionHs :: Either [(String,String)] [(String,String)] -> String
-generateVersionHs settings = either error id $ do
-    let getSetting' = getSetting settings
-    cProjectGitCommitId <- getSetting' "cProjectGitCommitId" "Project Git commit id"
-    cProjectVersion     <- getSetting' "cProjectVersion"     "Project version"
-    cProjectVersionInt  <- getSetting' "cProjectVersionInt"  "Project Version Int"
-
-    cProjectPatchLevel  <- getSetting' "cProjectPatchLevel"  "Project Patch Level"
-    cProjectPatchLevel1 <- getSetting' "cProjectPatchLevel1" "Project Patch Level1"
-    cProjectPatchLevel2 <- getSetting' "cProjectPatchLevel2" "Project Patch Level2"
-    return $ unlines
-        [ "module GHC.Version where"
-        , ""
-        , "import Prelude -- See Note [Why do we import Prelude here?]"
-        , ""
-        , "cProjectGitCommitId   :: String"
-        , "cProjectGitCommitId   = " ++ show cProjectGitCommitId
-        , ""
-        , "cProjectVersion       :: String"
-        , "cProjectVersion       = " ++ show cProjectVersion
-        , ""
-        , "cProjectVersionInt    :: String"
-        , "cProjectVersionInt    = " ++ show cProjectVersionInt
-        , ""
-        , "cProjectPatchLevel    :: String"
-        , "cProjectPatchLevel    = " ++ show cProjectPatchLevel
         , ""
-        , "cProjectPatchLevel1   :: String"
-        , "cProjectPatchLevel1   = " ++ show cProjectPatchLevel1
+        , "toArch I386 = ArchX86"
+        , "toArch X86_64 = ArchX86_64"
+        , "toArch PPC = ArchPPC"
+        , "toArch PPC64 = ArchPPC_64 ELF_V1"
+        , "toArch PPC64LE = ArchPPC_64 ELF_V2"
+        , "toArch Sparc = ArchUnknown -- ?"
+        , "toArch Sparc64 = ArchUnknown -- ?"
+        , "toArch Arm = ArchARM ARMv7 [] SOFT -- ?"
+        , "toArch AArch64 = ArchAArch64"
+        , "toArch Mips = ArchUnknown -- ?"
+        , "toArch SH = ArchUnknown -- ?"
+        , "toArch IA64 = ArchUnknown -- ?"
+        , "toArch S390 = ArchUnknown -- ?"
+        , "toArch S390X = ArchUnknown -- ?"
+        , "toArch Alpha = ArchAlpha"
+        , "toArch Hppa = ArchUnknown -- ?"
+        , "toArch Rs6000 = ArchUnknown -- ?"
+        , "toArch M68k = ArchUnknown -- ?"
+        , "toArch Vax = ArchUnknown -- ?"
+        , "toArch RISCV64 = ArchRISCV64"
+        , "toArch LoongArch64 = ArchLoongArch64"
+        , "toArch JavaScript = ArchJavaScript"
+        , "toArch Wasm32 = ArchWasm32"
+        , "toArch (OtherArch _) = ArchUnknown"
         , ""
-        , "cProjectPatchLevel2   :: String"
-        , "cProjectPatchLevel2   = " ++ show cProjectPatchLevel2
+        , "toOS Linux = OSLinux"
+        , "toOS Windows = OSMinGW32"
+        , "toOS OSX = OSDarwin"
+        , "toOS FreeBSD = OSFreeBSD"
+        , "toOS OpenBSD = OSOpenBSD"
+        , "toOS NetBSD = OSNetBSD"
+        , "toOS DragonFly = OSDragonFly"
+        , "toOS Solaris = OSSolaris2"
+        , "toOS AIX = OSAIX"
+        , "toOS HPUX = OSUnknown -- ?"
+        , "toOS IRIX = OSUnknown -- ?"
+        , "toOS HaLVM = OSUnknown -- ?"
+        , "toOS Hurd = OSHurd"
+        , "toOS IOS = OSUnknown -- ?"
+        , "toOS Android = OSUnknown -- ?"
+        , "toOS Ghcjs = OSGhcjs"
+        , "toOS Wasi = OSWasi"
+        , "toOS Haiku = OSHaiku"
+        , "toOS (OtherOS _) = OSUnknown"
         ]

libraries/ghc-boot/ghc-boot.cabal.in

@@ -1,4 +1,4 @@
-cabal-version:  3.0
+cabal-version:  3.12
 
 -- WARNING: ghc-boot.cabal is automatically generated from ghc-boot.cabal.in by
 -- ../../configure.  Make sure you are editing ghc-boot.cabal.in, not
@@ -28,7 +28,7 @@ build-type:     Custom
 extra-source-files: changelog.md
 
 custom-setup
-    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.18, directory, filepath
+    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.18, Cabal-syntax >= 3.6 && <3.18, directory, filepath
 
 source-repository head
     type:     git
@@ -72,12 +72,16 @@ Library
 
     -- but done by Hadrian
     autogen-modules:
-            GHC.Version
+            PackageInfo_ghc_boot
             GHC.Platform.Host
 
+    other-modules:
+            PackageInfo_ghc_boot
+
     build-depends: base       >= 4.7 && < 4.23,
                    binary     == 0.8.*,
                    bytestring >= 0.10 && < 0.13,
+                   Cabal-syntax >= 3.6 && <3.18,
                    containers >= 0.5 && < 0.9,
                    directory  >= 1.2 && < 1.4,
                    filepath   >= 1.3 && < 1.6,

utils/ghc-toolchain/exe/Main.hs

@@ -33,7 +33,7 @@ import GHC.Toolchain.Tools.Ranlib
 import GHC.Toolchain.Tools.Nm
 import GHC.Toolchain.Tools.MergeObjs
 import GHC.Toolchain.Tools.Readelf
-import GHC.Toolchain.NormaliseTriple (normaliseTriple)
+import GHC.Toolchain.NormaliseTriple (normaliseTriple, normaliseLlvmTarget)
 import Text.Read (readMaybe)
 
 data Opts = Opts
@@ -440,8 +440,9 @@ ldOverrideWhitelist a =
 mkTarget :: Opts -> M Target
 mkTarget opts = do
     normalised_triple <- normaliseTriple (fromMaybe (error "missing --triple") (optTriple opts))
-    -- Use Llvm target if specified, otherwise use triple as llvm target
-    let tgtLlvmTarget = fromMaybe normalised_triple (optLlvmTriple opts)
+    -- Use Llvm target if specified, otherwise use triple as llvm target.
+    -- Normalise for platform conventions (e.g. aarch64-apple-* -> arm64-apple-*).
+    let tgtLlvmTarget = normaliseLlvmTarget $ fromMaybe normalised_triple (optLlvmTriple opts)
 
     (archOs, tgtVendor) <- do
       cc0 <- findBasicCc (optCc opts)

utils/ghc-toolchain/src/GHC/Toolchain/NormaliseTriple.hs

@@ -1,8 +1,12 @@
-module GHC.Toolchain.NormaliseTriple where
+module GHC.Toolchain.NormaliseTriple
+  ( normaliseTriple
+  , normaliseLlvmTarget
+  ) where
 
 import GHC.Toolchain.Prelude
 import GHC.Toolchain.Program
 import Data.Text (strip, pack, unpack)
+import Data.List (isPrefixOf)
 
 -- | Normalise the triple by calling `config.sub` on the given triple.
 normaliseTriple :: String -> M String
@@ -11,3 +15,18 @@ normaliseTriple triple = do
   normalised_triple <- norm <$> readProgramStdout shProgram ["config.sub", triple]
   logInfo $ unwords ["Normalised triple:", triple, "~>", normalised_triple]
   return normalised_triple
+
+-- | Normalise the LLVM target triple for platform conventions.
+--
+-- Apple's LLVM toolchain uses @arm64@ as the canonical architecture name
+-- for AArch64 on Apple platforms, while GNU config.sub normalises to
+-- @aarch64@. This mismatch causes problems with toolchain wrappers (e.g.
+-- nix cc-wrapper) that do string comparison on the @--target@ flag.
+--
+-- See also: the @llvm-targets@ file uses @arm64-apple-darwin@.
+normaliseLlvmTarget :: String -> String
+normaliseLlvmTarget triple
+  | "aarch64-apple-" `isPrefixOf` triple
+  = "arm64-" ++ drop (length "aarch64-") triple
+  | otherwise
+  = triple