[Git][ghc/ghc][wip/hadrian-windows-bindist-cross] 2 commits: ghc-toolchain: Normalise triple via config.sub

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/hadrian-windows-bindist-cross at Glasgow Haskell Compiler / GHC


Commits:
7f878e4c by Matthew Pickering at 2023-08-21T11:31:01+01:00
ghc-toolchain: Normalise triple via config.sub

We were not normalising the target triple anymore like we did with the
old make build system.

TODO: Should the target prefix use the normalised or unnormalised
platform?

- - - - -
65bc9cbe by Matthew Pickering at 2023-08-21T11:31:07+01:00
ghc-toolchain: Add missing vendor normalisation

This is copied from m4/ghc_convert_vendor.m4

- - - - -


5 changed files:

- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/ghc-toolchain.cabal
- + utils/ghc-toolchain/src/GHC/Toolchain/NormaliseTriple.hs
- utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Program.hs


Changes:

=====================================
utils/ghc-toolchain/exe/Main.hs
=====================================
@@ -31,6 +31,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)
 
 data Opts = Opts
     { optTriple    :: String
@@ -367,15 +368,17 @@ ldOverrideWhitelist a =
     _ -> False
 
 
+
 mkTarget :: Opts -> M Target
 mkTarget opts = do
+    normalised_triple <- normaliseTriple (optTriple opts)
     -- Use Llvm target if specified, otherwise use triple as llvm target
-    let tgtLlvmTarget = fromMaybe (optTriple opts) (optLlvmTriple opts)
+    let tgtLlvmTarget = fromMaybe normalised_triple (optLlvmTriple opts)
     cc0 <- findCc tgtLlvmTarget (optCc opts)
     cxx <- findCxx tgtLlvmTarget (optCxx opts)
     cpp <- findCpp (optCpp opts) cc0
     hsCpp <- findHsCpp (optHsCpp opts) cc0
-    (archOs, tgtVendor) <- parseTriple cc0 (optTriple opts)
+    (archOs, tgtVendor) <- parseTriple cc0 normalised_triple
     cc <- addPlatformDepCcFlags archOs cc0
     readelf <- optional $ findReadelf (optReadelf opts)
     ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (ldOverrideWhitelist archOs && fromMaybe True (optLdOverride opts)) archOs cc readelf


=====================================
utils/ghc-toolchain/ghc-toolchain.cabal
=====================================
@@ -17,6 +17,7 @@ library
                       GHC.Toolchain.Prelude,
                       GHC.Toolchain.Program,
                       GHC.Toolchain.ParseTriple,
+                      GHC.Toolchain.NormaliseTriple,
                       GHC.Toolchain.CheckArm,
                       GHC.Toolchain.Target,
                       GHC.Toolchain.Tools.Ar,


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/NormaliseTriple.hs
=====================================
@@ -0,0 +1,13 @@
+module GHC.Toolchain.NormaliseTriple where
+
+import GHC.Toolchain.Prelude
+import GHC.Toolchain.Program
+import Data.Text (strip, pack, unpack)
+
+-- | Normalise the triple by calling `config.sub` on the given triple.
+normaliseTriple :: String -> M String
+normaliseTriple triple = do
+  let norm = unpack . strip . pack
+  normalised_triple <- norm <$> readProgramStdout shProgram ["config.sub", triple]
+  logInfo $ unwords ["Normalised triple:", triple, "~>", normalised_triple]
+  return normalised_triple


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs
=====================================
@@ -20,12 +20,12 @@ parseTriple cc triple
   | [archName, vendorName, osName] <- parts
   = do arch <- parseArch cc archName
        os   <- parseOs osName
-       return (ArchOS arch os, Just vendorName)
+       return (ArchOS arch os, Just (parseVendor vendorName))
 
   | [archName, vendorName, osName, _abi] <- parts
   = do arch <- parseArch cc archName
        os   <- parseOs osName
-       return (ArchOS arch os, Just vendorName)
+       return (ArchOS arch os, Just (parseVendor vendorName))
 
   | otherwise
   = throwE $ "malformed triple " ++ triple
@@ -80,6 +80,20 @@ parseOs os =
       "ghcjs" -> pure OSGhcjs
       _ -> throwE $ "Unknown operating system " ++ os
 
+parseVendor :: String -> String
+parseVendor vendor =
+  case vendor of
+    -- like i686-pc-linux-gnu, i686-gentoo-freebsd8, x86_64-w64-mingw32
+    "pc" -> "unknown"
+    "gentoo" -> "unknown"
+    "w64" -> "unknown"
+    -- like armv5tel-softfloat-linux-gnueabi
+    "softfloat" -> "unknown"
+    -- like armv7a-hardfloat-linux-gnueabi
+    "hardfloat" -> "unknown"
+    -- Pass through by default
+    _ -> vendor
+
 splitOn :: Char -> String -> [String]
 splitOn sep = go
   where


=====================================
utils/ghc-toolchain/src/GHC/Toolchain/Program.hs
=====================================
@@ -1,5 +1,6 @@
 module GHC.Toolchain.Program
     ( Program(..)
+    , shProgram
     , _prgPath
     , _prgFlags
     , addFlagIfNew
@@ -37,6 +38,9 @@ data Program = Program { prgPath :: FilePath
                        }
     deriving (Read, Eq, Ord)
 
+shProgram :: Program
+shProgram = Program "sh" []
+
 instance Show Program where
   -- Normalise filepaths before showing to aid with diffing the target files.
   show (Program p f) = unwords



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c444a7c43af903b261e0a3a53b75ce8eb0ae9988...65bc9cbeee221ab4fe6f82eb0504d18a825f7e11

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c444a7c43af903b261e0a3a53b75ce8eb0ae9988...65bc9cbeee221ab4fe6f82eb0504d18a825f7e11
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230821/93388d21/attachment-0001.html>