GitLab

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

54cf3c1e

by sheaf at 2026-11-03T07:00:23-05:00

Consolidate all CPU feature handling

This commit introduces GHC.Platform.CpuFeatures which consolidates all
of the logic for implications between CPU feature flags (mainly X86):

  - DynFlags now only records the set of -m<feature> flags that were
    passed, as an EnumSet CpuFeature. That keeps it a simple record of
    the flags the user passed, with no post-processing.

  - GHC.Platform.CpuFeatures.initCpuFeatures turns this set into a
    CpuFeatures value, applying all implications and the per-architecture
    baseline. This is the single home for all of the feature implication
    logic.

    Some datatypes were reworked to better reflect the implication
    structure in the types, e.g. SseAvxVersion has a strategically
    placed 'FMA' boolean.

  - The NCG, LLVM backend, StgToCmm, CPP defines and LLVM -mattr
    flags all consult CpuFeatures, via targetCpuFeatures.

See Note [CPU features], which replaces
Note [Implications between X86 CPU feature flags].

Behaviour changes:

  - x86 feature flags (-msse3, -mavx, -mavx512*, -mgfni, ...) passed
    when targeting a non-x86 architecture no longer cause x86 CPP
    macros (__SSE3__, __AVX512BW__, __GFNI__, ...) to be defined, nor
    x86 attributes to be passed to LLVM.
  - Error messages reported when required CPU features are not enabled
    now print out the minimal set of flags required
    (e.g. "-mavx512vl" rather than "-mavx512f -mavx512vl").

19 changed files:

compiler/GHC/Cmm/CallConv.hs
compiler/GHC/CmmToAsm/Config.hs
compiler/GHC/CmmToAsm/X86/CodeGen.hs
compiler/GHC/CmmToAsm/X86/Instr.hs
compiler/GHC/CmmToLlvm/CodeGen.hs
compiler/GHC/CmmToLlvm/Config.hs
compiler/GHC/Driver/Config/CmmToAsm.hs
compiler/GHC/Driver/Config/CmmToLlvm.hs
compiler/GHC/Driver/Config/StgToCmm.hs
compiler/GHC/Driver/DynFlags.hs
compiler/GHC/Driver/Pipeline/Execute.hs
compiler/GHC/Driver/Session.hs
compiler/GHC/Platform.hs
+ compiler/GHC/Platform/CpuFeatures.hs
compiler/GHC/StgToCmm/Config.hs
compiler/GHC/StgToCmm/Prim.hs
compiler/GHC/SysTools/Cpp.hs
compiler/ghc.cabal.in
testsuite/tests/count-deps/CountDepsParser.stdout

Changes:

compiler/GHC/Cmm/CallConv.hs

@@ -203,11 +203,7 @@ realDoubleRegs  platform = map DoubleReg  $ regList (pc_MAX_Real_Double_REG  (pl
  realLongRegs    platform = map LongReg    $ regList (pc_MAX_Real_Long_REG    (platformConstants platform))
  realXmmRegNos :: Platform -> [Int]
 -realXmmRegNos platform
 -    | isSse2Enabled platform || platformArch platform == ArchAArch64
 -    = regList (pc_MAX_Real_XMM_REG (platformConstants platform))
 -    | otherwise
 -    = []
 +realXmmRegNos platform = regList (pc_MAX_Real_XMM_REG (platformConstants platform))
  regList :: Int -> [Int]
  regList n = [1 .. n]

compiler/GHC/CmmToAsm/Config.hs

  -- | Native code generator configuration
  module GHC.CmmToAsm.Config
     ( NCGConfig(..)
 +   , ncgX86Features
     , ncgWordWidth
     , ncgSpillPreallocSize
     , platformWordWidth
@@ -9,10 +10,12 @@ where
  import GHC.Prelude
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Cmm.Type (Width(..))
  import GHC.CmmToAsm.CFG.Weight
  import GHC.Unit.Module (Module)
  import GHC.Utils.Outputable
 +import GHC.Utils.Panic
  -- | Native code generator configuration
  data NCGConfig = NCGConfig
@@ -29,12 +32,7 @@ data NCGConfig = NCGConfig
     , ncgRegsGraph             :: !Bool
     , ncgAsmLinting            :: !Bool            -- ^ Perform ASM linting pass
     , ncgDoConstantFolding     :: !Bool            -- ^ Perform CMM constant folding
 -   , ncgSseAvxVersion         :: Maybe SseAvxVersion -- ^ (x86) SSE and AVX instructions
 -   , ncgAvx512fEnabled        :: !Bool
 -   , ncgAvx512vlEnabled       :: !Bool
 -   , ncgAvx512bwEnabled       :: !Bool
 -   , ncgAvx512dqEnabled       :: !Bool
 -   , ncgBmiVersion            :: Maybe BmiVersion -- ^ (x86) BMI instructions
 +   , ncgCpuFeatures           :: !CpuFeatures     -- ^ Enabled CPU features
     , ncgDumpRegAllocStages    :: !Bool
     , ncgDumpAsmStats          :: !Bool
     , ncgDumpAsmConflicts      :: !Bool
@@ -54,6 +52,13 @@ data NCGConfig = NCGConfig
     , ncgLa664Enabled          :: !Bool            -- ^ la664 is equal to isav1.1
+    }
 +-- | X86 only: enabled x86 CPU features.
 +ncgX86Features :: NCGConfig -> X86Features
 +ncgX86Features config =
 +  case ncgCpuFeatures config of
 +    X86CpuFeatures feats -> feats
 +    _ -> panic "ncgX86Features: not an x86 target"
++
  -- | Return Word size
  ncgWordWidth :: NCGConfig -> Width
  ncgWordWidth config = platformWordWidth (ncgPlatform config)

compiler/GHC/CmmToAsm/X86/CodeGen.hs

@@ -56,6 +56,7 @@ import GHC.CmmToAsm.Config
  import GHC.Platform.Reg
  import GHC.CmmToAsm.Reg.Target (targetClassOfReg)
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Platform.Reg.Class.Unified (RegClass(..))
  -- Our intermediate code:
@@ -99,43 +100,7 @@ import Data.Word
  import qualified Data.Map as Map
 -is32BitPlatform :: NatM Bool
 -is32BitPlatform = do
 -    platform <- getPlatform
 -    return $ target32Bit platform
+-
 --- These flags may be implied by other flags like -mfma or -mavx512f.
 --- See Note [Implications between X86 CPU feature flags] for details.
 -ssse3Enabled :: NatM Bool
 -ssse3Enabled = do
 -  config <- getConfig
 -  return (ncgSseAvxVersion config >= Just SSSE3)
+-
 -sse4_1Enabled :: NatM Bool
 -sse4_1Enabled = do
 -  config <- getConfig
 -  return (ncgSseAvxVersion config >= Just SSE4)
+-
 -sse4_2Enabled :: NatM Bool
 -sse4_2Enabled = do
 -  config <- getConfig
 -  return (ncgSseAvxVersion config >= Just SSE42)
+-
 -avxEnabled :: NatM Bool
 -avxEnabled = do
 -  config <- getConfig
 -  return (ncgSseAvxVersion config >= Just AVX1)
+-
 -avx2Enabled :: NatM Bool
 -avx2Enabled = do
 -  config <- getConfig
 -  return (ncgSseAvxVersion config >= Just AVX2)
+-
 -avx512vlEnabled :: NatM Bool
 -avx512vlEnabled = ncgAvx512vlEnabled <$> getConfig
+-
 -avx512dqEnabled :: NatM Bool
 -avx512dqEnabled = ncgAvx512dqEnabled <$> getConfig
 +--------------------------------------------------------------------------------
  cmmTopCodeGen
          :: RawCmmDecl
@@ -426,7 +391,9 @@ swizzleRegisterRep (Any _ codefn)     format = Any   format codefn
  getLocalRegReg :: LocalReg -> Reg
  getLocalRegReg (LocalReg u ty)
 -  = -- by assuming SSE2, Int, Word, Float, Double and vectors all can be register allocated
 +  = -- Int, Word, Float, Double and vectors can all be register allocated, as the
 +    -- baseline instruction set includes SSE2: see 'x86BaselineSseAvx' in
 +    -- GHC.Platform.CpuFeatures.
      RegVirtual (mkVirtualReg u (cmmTypeFormat ty))
  -- | Grab the Reg for a CmmReg
@@ -495,6 +462,20 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
    where i64 = fromIntegral i :: Int64
 +-- -----------------------------------------------------------------------------
 +-- NCG configuration options (e.g. enabled X86 CPU features)
++
 +is32BitPlatform :: NatM Bool
 +is32BitPlatform = do
 +    platform <- getPlatform
 +    return $ target32Bit platform
++
 +-- | Whether an x86 instruction set is enabled, e.g. @x86Feature x86AvxEnabled@.
 +--
 +-- See Note [CPU features] for the implication structure of X86 features.
 +x86Feature :: (X86Features -> res) -> NatM res
 +x86Feature f = f . ncgX86Features <$> getConfig
++
  -- -----------------------------------------------------------------------------
  -- General things for putting together code sequences
@@ -976,11 +957,11 @@ getRegister' _ _ (CmmMachOp mop []) =
    pprPanic "getRegister(x86): nullary MachOp" (text $ show mop)
  getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
 -    sse42   <- sse4_2Enabled
 -    ssse3    <- ssse3Enabled
 -    avx     <- avxEnabled
 -    avx2    <- avx2Enabled
 -    avx512vl <- avx512vlEnabled
 +    sse42    <- x86Feature x86Sse4_2Enabled
 +    ssse3    <- x86Feature x86Ssse3Enabled
 +    avx      <- x86Feature x86AvxEnabled
 +    avx2     <- x86Feature x86Avx2Enabled
 +    avx512vl <- x86Feature x86Avx512VLEnabled
      case mop of
        MO_F_Neg w  -> sse2NegCode w x
@@ -1459,11 +1440,11 @@ getRegister' platform is32Bit (CmmMachOp (MO_Xor w) [x, y])
    = genBitTestCode (intFormat w) BTC opnd ix
  getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
 -  sse4_1 <- sse4_1Enabled
 -  sse4_2 <- sse4_2Enabled
 -  avx <- avxEnabled
 -  avx512vl <- avx512vlEnabled
 -  avx512dq <- avx512dqEnabled
 +  sse4_1 <- x86Feature x86Sse4_1Enabled
 +  sse4_2 <- x86Feature x86Sse4_2Enabled
 +  avx <- x86Feature x86AvxEnabled
 +  avx512vl <- x86Feature x86Avx512VLEnabled
 +  avx512dq <- x86Feature x86Avx512DQEnabled
    case mop of
        MO_F_Eq _ -> condFltReg is32Bit EQQ x y
        MO_F_Ne _ -> condFltReg is32Bit NE  x y
@@ -2607,7 +2588,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
          -- PALIGNR (SSSE3) or PSLLDQ + PSRLDQ: is == [i,i+1,...,n-2,n-1;n,n+1,...,n+i-1]
          | (js, ks) <- span (< n) is, and (zipWith (==) (reverse js) [n-1,n-2..]), and (zipWith (==) ks [n..]) -> Just $ do
 -          ssse3 <- ssse3Enabled
 +          ssse3 <- x86Feature x86Ssse3Enabled
            let amountInBytes = widthInBytes * length ks
            if ssse3
              then vector_op_sse (`PALIGNR` (ImmInt amountInBytes)) fmt v2 v1
@@ -2624,7 +2605,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
          -- PALIGNR (SSSE3) or PSLLDQ + PSRLDQ: is == [n+i,n+i+1,...,2n-2,2n-1;0,1,...,i-1]
          | (js, ks) <- span (>= n) is, and (zipWith (==) (reverse js) [2*n-1,2*n-2..]), and (zipWith (==) ks [0..]) -> Just $ do
 -          ssse3 <- ssse3Enabled
 +          ssse3 <- x86Feature x86Ssse3Enabled
            let amountInBytes = widthInBytes * length ks
            if ssse3
              then vector_op_sse (`PALIGNR` (ImmInt amountInBytes)) fmt v1 v2
@@ -2663,7 +2644,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
      vector_shuffle_int8x16 sse4_1 v1 v2 is
        | Just commonCase <- vector_shuffle_int128_common sse4_1 fmt v1 v2 is = commonCase
        | otherwise = do
 -        ssse3 <- ssse3Enabled
 +        ssse3 <- x86Feature x86Ssse3Enabled
          let fmtInt16X8 = VecFormat 8 FmtInt16
              v1IsZero = isZeroVecLit v1
              v2IsZero = isZeroVecLit v2
@@ -3021,8 +3002,8 @@ getRegister' platform is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
  getRegister' platform _is32Bit (CmmMachOp mop [x, y, z]) = do -- ternary MachOps
 -  avx    <- avxEnabled
 -  sse4_1 <- sse4_1Enabled
 +  avx    <- x86Feature x86AvxEnabled
 +  sse4_1 <- x86Feature x86Sse4_1Enabled
    case mop of
        -- Floating point fused multiply-add operations @ ± x*y ± z@
        MO_FMA var l w
@@ -3325,7 +3306,7 @@ getRegister' platform is32Bit (CmmLit lit)
      is_label _                    = False
  getRegister' platform is32Bit (CmmLit lit) = do
 -  avx <- avxEnabled
 +  avx <- x86Feature x86AvxEnabled
    -- NB: it is important that the code produced here (to load a literal into
    -- a register) doesn't clobber any registers other than the destination
@@ -4764,7 +4745,8 @@ genCCall32 addr _conv dest_regs args = do
                | isVecType ty
                = unitOL (mkRegRegMoveInstr config (cmmTypeFormat ty) xmm0 r_dest)
                | isFloatType ty =
 -                  -- we assume SSE2
 +                  -- SSE2 is in the baseline instruction set: see 'x86BaselineSseAvx'
 +                  -- in GHC.Platform.CpuFeatures.
                    let tmp_amode = AddrBaseIndex (EABaseReg esp)
                                                         EAIndexNone
                                                         (ImmInt 0)
@@ -6418,7 +6400,7 @@ genCtzGeneric width dst src = do
    config <- getConfig
    let bw = widthInBits width
    let dst_r = getLocalRegReg dst
 -  if ncgBmiVersion config >= Just BMI2
 +  if x86Bmi2Enabled (ncgX86Features config)
    then do
        src_r <- getNewRegNat (intFormat width)
        let instrs = appOL (code_src src_r) $ case width of
@@ -6735,7 +6717,7 @@ genPopCnt bid width dst src = do
      platform = ncgPlatform config
      format = intFormat width
 -  sse4_2Enabled >>= \case
 +  x86Feature x86Sse4_2Enabled >>= \case
      True -> do
        code_src <- getAnyReg src
@@ -6771,7 +6753,7 @@ genPdep bid width dst src mask = do
      platform = ncgPlatform config
      format = intFormat width
 -  if ncgBmiVersion config >= Just BMI2
 +  if x86Bmi2Enabled (ncgX86Features config)
      then do
        code_src  <- getAnyReg src
        code_mask <- getAnyReg mask
@@ -6798,7 +6780,7 @@ genPdep bid width dst src mask = do
  genPext :: BlockId -> Width -> LocalReg -> CmmExpr -> CmmExpr -> NatM InstrBlock
  genPext bid width dst src mask = do
    config <- getConfig
 -  if ncgBmiVersion config >= Just BMI2
 +  if x86Bmi2Enabled (ncgX86Features config)
      then do
        let format   = intFormat width
        let dst_r    = getLocalRegReg dst
@@ -6835,7 +6817,7 @@ genClz bid width dst src = do
      else do
        code_src <- getAnyReg src
        let dst_r = getLocalRegReg dst
 -      if ncgBmiVersion config >= Just BMI2
 +      if x86Bmi2Enabled (ncgX86Features config)
          then do
            src_r <- getNewRegNat (intFormat width)
            return $ appOL (code_src src_r) $ case width of

compiler/GHC/CmmToAsm/X86/Instr.hs

@@ -65,6 +65,7 @@ import GHC.Utils.Constants ( debugIsOn )
  import GHC.Utils.Outputable
  import GHC.Utils.Panic
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Cmm.CLabel
  import GHC.Types.Unique.Set
@@ -1182,9 +1183,10 @@ movInstr config fmt =
        = f
      plat    = ncgPlatform config
 -    avx     = ncgSseAvxVersion config >= Just AVX1
 -    avx2    = ncgSseAvxVersion config >= Just AVX2
 -    avx512f = ncgAvx512fEnabled config
 +    feats   = ncgX86Features config
 +    avx     = x86AvxEnabled feats
 +    avx2    = x86Avx2Enabled feats
 +    avx512f = x86Avx512FEnabled feats
      avx_move sFmt =
        if isFloatScalarFormat sFmt
        then assertCompatibleRegs $

compiler/GHC/CmmToLlvm/CodeGen.hs

@@ -260,12 +260,12 @@ discussion about portable pdep/pext intrinsics.
  -}
  genCall (PrimTarget op@(MO_Pdep w)) [dst] args = do
      cfg <- getConfig
 -    if  llvmCgBmiVersion cfg >= Just BMI2
 +    if  llvmCgBmi2Enabled cfg
          then genCallMinimumTruncationCast W32 w op dst args
          else genCallSimpleCast w op dst args
  genCall (PrimTarget op@(MO_Pext w)) [dst] args = do
      cfg <- getConfig
 -    if  llvmCgBmiVersion cfg >= Just BMI2
 +    if  llvmCgBmi2Enabled cfg
          then genCallMinimumTruncationCast W32 w op dst args
          else genCallSimpleCast w op dst args
@@ -852,7 +852,7 @@ cmmPrimOpFunctions :: CallishMachOp -> LlvmM LMString
  cmmPrimOpFunctions mop = do
    cfg      <- getConfig
    platform <- getPlatform
 -  let !isBmi2Enabled = llvmCgBmiVersion cfg >= Just BMI2
 +  let !isBmi2Enabled = llvmCgBmi2Enabled cfg
        !is32bit       = platformWordSize platform == PW4
        unsupported = panic ("cmmPrimOpFunctions: " ++ show mop
                          ++ " not supported here")

compiler/GHC/CmmToLlvm/Config.hs

  -- | Llvm code generator configuration
  module GHC.CmmToLlvm.Config
    ( LlvmCgConfig(..)
 +  , llvmCgBmi2Enabled
    , LlvmConfig(..)
    , LlvmTarget(..)
    , initLlvmConfig
@@ -9,6 +10,7 @@ where
  import GHC.Prelude
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Utils.Outputable
  import GHC.Settings.Utils
@@ -22,7 +24,7 @@ data LlvmCgConfig = LlvmCgConfig
    , llvmCgContext           :: !SDocContext  -- ^ Context for LLVM code generation
    , llvmCgFillUndefWithGarbage :: !Bool      -- ^ Fill undefined literals with garbage values
    , llvmCgSplitSection      :: !Bool         -- ^ Split sections
 -  , llvmCgBmiVersion        :: Maybe BmiVersion  -- ^ (x86) BMI instructions
 +  , llvmCgCpuFeatures       :: !CpuFeatures  -- ^ Enabled CPU features
    , llvmCgLlvmVersion       :: Maybe LlvmVersion -- ^ version of Llvm we're using
    , llvmCgDoWarn            :: !Bool         -- ^ True ==> warn unsupported Llvm version
    , llvmCgLlvmTarget        :: !String       -- ^ target triple passed to LLVM
@@ -30,6 +32,13 @@ data LlvmCgConfig = LlvmCgConfig
                                               -- see Note [LLVM configuration]
+   }
 +-- | Whether BMI2 instructions are enabled (x86 only).
 +llvmCgBmi2Enabled :: LlvmCgConfig -> Bool
 +llvmCgBmi2Enabled cfg =
 +  case llvmCgCpuFeatures cfg of
 +    X86CpuFeatures feats -> x86Bmi2Enabled feats
 +    _                    -> False
++
  data LlvmTarget = LlvmTarget
    { lDataLayout :: String
    , lCPU        :: String

compiler/GHC/Driver/Config/CmmToAsm.hs

@@ -39,37 +39,8 @@ initNCGConfig dflags this_mod = NCGConfig
     , ncgDumpRegAllocStages    = dopt Opt_D_dump_asm_regalloc_stages dflags
     , ncgDumpAsmStats          = dopt Opt_D_dump_asm_stats dflags
     , ncgDumpAsmConflicts      = dopt Opt_D_dump_asm_conflicts dflags
 -   , ncgBmiVersion            = case platformArch (targetPlatform dflags) of
 -                                 ArchX86_64 -> bmiVersion dflags
 -                                 ArchX86    -> bmiVersion dflags
 -                                 _          -> Nothing
+-
 -     -- We assume  SSE1 and SSE2 operations are available on both
 -     -- x86 and x86_64. Historically we didn't default to SSE2 and
 -     -- SSE1 on x86, which results in defacto nondeterminism for how
 -     -- rounding behaves in the associated x87 floating point instructions
 -     -- because variations in the spill/fpu stack placement of arguments for
 -     -- operations would change the precision and final result of what
 -     -- would otherwise be the same expressions with respect to single or
 -     -- double precision IEEE floating point computations.
+-
 -     -- ncgSseAvxVersion is set to the actual SSE/AVX version.
 -     -- For example, -mfma does not set DynFlags's sseAvxVersion, but makes ncgSseAvxVersion >= AVX1.
 -     -- See also Note [Implications between X86 CPU feature flags]
 -   , ncgSseAvxVersion =
 -      let v | isAvx2Enabled dflags = Just AVX2 -- -mavx512f does not set sseAvxVersion, but makes isAvx2Enabled true
 -            | isAvxEnabled dflags  = Just AVX1 -- -mfma does not set sseAvxVersion, but makes isAvxEnabled true
 -            | otherwise            = max (Just SSE2) (sseAvxVersion dflags)
 -      in case platformArch (targetPlatform dflags) of
 -            ArchX86_64 -> v
 -            ArchX86    -> v
 -            _          -> Nothing
 -   , ncgAvx512fEnabled = isAvx512fEnabled dflags
 -   , ncgAvx512vlEnabled = isAvx512vlEnabled dflags
 -   , ncgAvx512bwEnabled = isAvx512bwEnabled dflags
 -   , ncgAvx512dqEnabled = isAvx512dqEnabled dflags
+-
 -   , ncgLa664Enabled = isLa664Enabled dflags
 +   , ncgCpuFeatures           = targetCpuFeatures dflags
 +   , ncgLa664Enabled          = isLa664Enabled dflags
     , ncgDwarfEnabled        = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 0 && platformArch (targetPlatform dflags) /= ArchAArch64
     , ncgDwarfUnwindings     = osElfTarget (platformOS (targetPlatform dflags)) && debugLevel dflags > 0

compiler/GHC/Driver/Config/CmmToLlvm.hs

@@ -23,10 +23,7 @@ initLlvmCgConfig logger config_cache dflags = do
      , llvmCgContext              = initSDocContext dflags PprCode
      , llvmCgFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags
      , llvmCgSplitSection         = gopt Opt_SplitSections dflags
 -    , llvmCgBmiVersion           = case platformArch (targetPlatform dflags) of
 -                                      ArchX86_64 -> bmiVersion dflags
 -                                      ArchX86    -> bmiVersion dflags
 -                                      _          -> Nothing
 +    , llvmCgCpuFeatures          = targetCpuFeatures dflags
      , llvmCgLlvmVersion          = version
      , llvmCgDoWarn               = wopt Opt_WarnUnsupportedLlvmVersion dflags
      , llvmCgLlvmTarget           = platformMisc_llvmTarget $! platformMisc dflags

compiler/GHC/Driver/Config/StgToCmm.hs

@@ -12,6 +12,7 @@ import GHC.Cmm.MachOp ( FMASign(..))
  import GHC.Driver.Backend
  import GHC.Driver.Session
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Platform.Profile
  import GHC.Platform.Regs
  import GHC.Utils.Error
@@ -63,7 +64,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
    , stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm
    , stgToCmmAllowFMAInstr =
        if
 -        | not (isFmaEnabled dflags)
 +        | not (cpuFmaEnabled cpu_feats)
          || not (ncg || llvm)
          -- If we're not using the native code generator or LLVM,
          -- fall back to the generic implementation.
@@ -81,12 +82,10 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
    , stgToCmmAllowIntMul2Instr         = (ncg && (x86ish || aarch64)) || llvm
    , stgToCmmAllowWordMul2Instr        = (ncg && (x86ish || ppc || aarch64)) || llvm
 -  , stgToCmmAllowIntWord64X2MinMax    = (ncg && ((x86ish && isSse4_2Enabled dflags) || aarch64)) || llvm
 +  , stgToCmmAllowIntWord64X2MinMax    = (ncg && (sse4_2 || aarch64)) || llvm
    -- SIMD flags
    , stgToCmmVecInstrsErr  = vec_err
 -  , stgToCmmAvx           = isAvxEnabled                   dflags
 -  , stgToCmmAvx2          = isAvx2Enabled                  dflags
 -  , stgToCmmAvx512f       = isAvx512fEnabled               dflags
 +  , stgToCmmCpuFeatures   = cpu_feats
    , stgToCmmUseStdApThunk = not $ gopt Opt_Ticky_AP dflags
    -- See Note [Saving foreign call target to local]
    , stgToCmmSaveFCallTargetToLocal = any (callerSaves platform) $ activeStgRegs platform
@@ -111,6 +110,10 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
                        ArchPPC      -> True
                        ArchPPC_64 _ -> True
                        _            -> False
 +          cpu_feats = targetCpuFeatures dflags
 +          sse4_2 = case cpu_feats of
 +                     X86CpuFeatures feats -> x86Sse4_2Enabled feats
 +                     _                    -> False
            vec_err = case backendSimdValidity (backend dflags) of
                        IsValid -> Nothing
                        NotValid msg -> Just msg

compiler/GHC/Driver/DynFlags.hs

@@ -78,23 +78,7 @@ module GHC.Driver.DynFlags (
          initPromotionTickContext,
          -- * Platform features
 -        isSse3Enabled,
 -        isSsse3Enabled,
 -        isSse4_1Enabled,
 -        isSse4_2Enabled,
 -        isAvxEnabled,
 -        isAvx2Enabled,
 -        isAvx512bwEnabled,
 -        isAvx512cdEnabled,
 -        isAvx512dqEnabled,
 -        isAvx512erEnabled,
 -        isAvx512fEnabled,
 -        isAvx512pfEnabled,
 -        isAvx512vlEnabled,
 -        isFmaEnabled,
 -        isGfniEnabled,
 -        isBmiEnabled,
 -        isBmi2Enabled,
 +        targetCpuFeatures,
          -- For LoongArch platform
          isLa664Enabled
  ) where
@@ -102,6 +86,7 @@ module GHC.Driver.DynFlags (
  import GHC.Prelude
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Platform.Ways
  import GHC.Platform.Profile
@@ -460,18 +445,9 @@ data DynFlags = DynFlags {
    interactivePrint      :: Maybe String,
 -  -- | Machine dependent flags (-m\<blah> stuff)
 -  sseAvxVersion         :: Maybe SseAvxVersion,
 -  bmiVersion            :: Maybe BmiVersion,
 -  avx512bw              :: Bool, -- ^ Enable AVX-512BW Instructions.
 -  avx512cd              :: Bool, -- ^ Enable AVX-512 Conflict Detection Instructions.
 -  avx512dq              :: Bool, -- ^ Enable AVX-512DQ Instructions.
 -  avx512er              :: Bool, -- ^ Enable AVX-512 Exponential and Reciprocal Instructions.
 -  avx512f               :: Bool, -- ^ Enable AVX-512 instructions.
 -  avx512pf              :: Bool, -- ^ Enable AVX-512 PreFetch Instructions.
 -  avx512vl              :: Bool, -- ^ Enable AVX-512VL Instructions.
 -  fma                   :: Bool, -- ^ Enable FMA instructions.
 -  gfni                  :: Bool, -- ^ Enable GFNI Instructions.
 +  -- Machine dependent flags (-m\<blah> stuff)
 +  cpuFeatures           :: EnumSet CpuFeature, -- ^ The @-m\<feature\>@ flags that were passed.
 +                                               -- See Note [CPU features] in GHC.Platform.CpuFeatures.
    la664                 :: Bool, -- ^ Enable LA664 instructions
    -- Constants used to control the amount of optimization done.
@@ -751,18 +727,7 @@ defaultDynFlags mySettings =
          profAuto = NoProfAuto,
          callerCcFilters = [],
          interactivePrint = Nothing,
 -        sseAvxVersion = Nothing,
 -        bmiVersion = Nothing,
 -        avx512bw = False,
 -        avx512cd = False,
 -        avx512dq = False,
 -        avx512er = False,
 -        avx512f = False,
 -        avx512pf = False,
 -        avx512vl = False,
 -        -- Use FMA by default on AArch64
 -        fma = (platformArch . sTargetPlatform $ mySettings) == ArchAArch64,
 -        gfni = False,
 +        cpuFeatures = EnumSet.empty,
          -- For LoongArch, la464 is used by default.
          la664 = False,
@@ -1621,111 +1586,16 @@ initPromotionTickContext dflags =
+   }
  -- -----------------------------------------------------------------------------
 --- SSE, AVX, FMA
 +-- CPU features
 -isSse3Enabled :: DynFlags -> Bool
 -isSse3Enabled dflags = sseAvxVersion dflags >= Just SSE3 || isAvxEnabled dflags
+-
 -isSsse3Enabled :: DynFlags -> Bool
 -isSsse3Enabled dflags = sseAvxVersion dflags >= Just SSSE3 || isAvxEnabled dflags
+-
 -isSse4_1Enabled :: DynFlags -> Bool
 -isSse4_1Enabled dflags = sseAvxVersion dflags >= Just SSE4 || isAvxEnabled dflags
+-
 -isSse4_2Enabled :: DynFlags -> Bool
 -isSse4_2Enabled dflags = sseAvxVersion dflags >= Just SSE42 || isAvxEnabled dflags
+-
 -isAvxEnabled :: DynFlags -> Bool
 -isAvxEnabled dflags = sseAvxVersion dflags >= Just AVX1 || (isX86 && fma dflags) || isAvx512fEnabled dflags
 -  where
 -    -- -mfma can be used on multiple platforms, but -mavx is x86-only
 -    isX86 = case platformArch (targetPlatform dflags) of
 -      ArchX86_64 -> True
 -      ArchX86    -> True
 -      _          -> False
+-
 -isAvx2Enabled :: DynFlags -> Bool
 -isAvx2Enabled dflags = sseAvxVersion dflags >= Just AVX2 || isAvx512fEnabled dflags
+-
 -isAvx512bwEnabled :: DynFlags -> Bool
 -isAvx512bwEnabled dflags = avx512bw dflags
+-
 -isAvx512cdEnabled :: DynFlags -> Bool
 -isAvx512cdEnabled dflags = avx512cd dflags
+-
 -isAvx512dqEnabled :: DynFlags -> Bool
 -isAvx512dqEnabled dflags = avx512dq dflags
+-
 -isAvx512erEnabled :: DynFlags -> Bool
 -isAvx512erEnabled dflags = avx512er dflags
+-
 -isAvx512fEnabled :: DynFlags -> Bool
 -isAvx512fEnabled dflags = avx512f dflags || avx512bw dflags || avx512cd dflags || avx512dq dflags || avx512er dflags || avx512pf dflags || avx512vl dflags
+-
 -isAvx512pfEnabled :: DynFlags -> Bool
 -isAvx512pfEnabled dflags = avx512pf dflags
+-
 -isAvx512vlEnabled :: DynFlags -> Bool
 -isAvx512vlEnabled dflags = avx512vl dflags
+-
 -isFmaEnabled :: DynFlags -> Bool
 -isFmaEnabled dflags = fma dflags || (isX86 && isAvx512fEnabled dflags)
 -  where
 -    -- -mfma is used on multiple platforms, but -mavx512f is x86-only
 -    isX86 = case platformArch (targetPlatform dflags) of
 -      ArchX86_64 -> True
 -      ArchX86    -> True
 -      _          -> False
+-
 -isGfniEnabled :: DynFlags -> Bool
 -isGfniEnabled dflags = gfni dflags
+-
 -{- Note [Implications between X86 CPU feature flags]
 -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -Many X86 CPU feature flags (such as -mavx, -mfma or -msse4) imply other
 -feature flags. In particular, there are straightforward linear implication
 -structures:
+-
 -  1. AVX2 -> AVX -> SSE4.2 -> SSE4 -> SSSE3 -> SSE3 -> SSE2 -> SSE1
 -  2. BMI2 -> BMI1
+-
 -together with other implications such as
+-
 -  3. FMA -> AVX
 -  4. AVX512{BW,CD,DQ,ER,PF,VL} -> AVX512F -> AVX2
+-
+-
 -We handle this as follows:
+-
 -  A. When parsing command line options into `DynFlags`, we record:
 -    - an `SseAvxVersion` which gives the SSE/AVX level supported in
 -      the total order (1),
 -    - a `BmiVersion` for (2),
 -    - whether FMA is enabled,
 -    - various AVX512 flags saying which AVX512 extensions are supported
+-
 -  B. When converting these "raw" `DynFlags` into a `CmmConfig` for use
 -     in code generator backends, we handle the remaining implications (3) (4),
 -     e.g. if the user passed -mavx512f then we also set the `SseAvxVersion`
 -     to `AVX2`.
 --}
 +-- | The CPU features enabled for the target.
 +--
 +-- See Note [CPU features] in GHC.Platform.CpuFeatures.
 +targetCpuFeatures :: DynFlags -> CpuFeatures
 +targetCpuFeatures dflags
 +  = initCpuFeatures (platformArch (targetPlatform dflags)) (cpuFeatures dflags)
  -- -----------------------------------------------------------------------------
  -- LA664
  isLa664Enabled :: DynFlags -> Bool
  isLa664Enabled dflags = la664 dflags
+-
 --- -----------------------------------------------------------------------------
 --- BMI2
+-
 -isBmiEnabled :: DynFlags -> Bool
 -isBmiEnabled dflags = case platformArch (targetPlatform dflags) of
 -    ArchX86_64 -> bmiVersion dflags >= Just BMI1
 -    ArchX86    -> bmiVersion dflags >= Just BMI1
 -    _          -> False
+-
 -isBmi2Enabled :: DynFlags -> Bool
 -isBmi2Enabled dflags = case platformArch (targetPlatform dflags) of
 -    ArchX86_64 -> bmiVersion dflags >= Just BMI2
 -    ArchX86    -> bmiVersion dflags >= Just BMI2
 -    _          -> False

compiler/GHC/Driver/Pipeline/Execute.hs

@@ -39,6 +39,7 @@ import GHC.Fingerprint
  import GHC.Utils.Logger
  import GHC.Utils.TmpFs
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import Data.List (intercalate, isInfixOf)
  import qualified Data.List.NonEmpty as NE
  import GHC.Unit.Env
@@ -968,35 +969,46 @@ llvmOptions llvm_config llvm_version dflags =
          arch = platformArch platform
          attrs :: String
 -        attrs = intercalate "," $ mattr
 -              ++ ["+sse4.2"  | isSse4_2Enabled dflags   ]
 -              ++ ["+popcnt"  | isSse4_2Enabled dflags   ]
 -                   -- LLVM gates POPCNT instructions behind the popcnt flag,
 -                   -- while the GHC NCG (as well as GCC, Clang) gates it
 -                   -- behind SSE4.2 instead.
 -              ++ ["+sse4.1"  | isSse4_1Enabled dflags   ]
 -              ++ ["+ssse3"   | isSsse3Enabled dflags    ]
 -              ++ ["+sse3"    | isSse3Enabled dflags     ]
 -              ++ ["+sse2"    | isSse2Enabled platform   ]
 -              ++ ["+sse"     | isSseEnabled platform    ]
 -              ++ ["+avx512f" | isAvx512fEnabled dflags  ]
 -              ++ ["+evex512" | isAvx512fEnabled dflags
 -                             , maybe False (>= LlvmVersion (18 NE.:| [])) llvm_version ]
 -                   -- +evex512 is recognized by LLVM 18 or newer and needed on macOS (#26410).
 -                   -- It may become deprecated in a future LLVM version, though.
 -              ++ ["+avx2"    | isAvx2Enabled dflags     ]
 -              ++ ["+avx"     | isAvxEnabled dflags      ]
 -              ++ ["+avx512bw"| isAvx512bwEnabled dflags ]
 -              ++ ["+avx512cd"| isAvx512cdEnabled dflags ]
 -              ++ ["+avx512dq"| isAvx512dqEnabled dflags ]
 -              ++ ["+avx512er"| isAvx512erEnabled dflags ]
 -              ++ ["+avx512pf"| isAvx512pfEnabled dflags ]
 -              ++ ["+avx512vl"| isAvx512vlEnabled dflags ]
 -              -- For AArch64 +fma is not a option (it's unconditionally available).
 -              ++ ["+fma"     | isFmaEnabled dflags && (arch /= ArchAArch64) ]
 -              ++ ["+bmi"     | isBmiEnabled dflags      ]
 -              ++ ["+bmi2"    | isBmi2Enabled dflags     ]
 -              ++ ["+gfni"    | isGfniEnabled dflags     ]
 +        attrs = intercalate "," $ mattr ++ cpu_attrs
++
 +        cpu_attrs :: [String]
 +        cpu_attrs = case targetCpuFeatures dflags of
 +          X86CpuFeatures feats@(X86Features { x86SseAvx = sseAvx, x86Bmi = bmi, x86Gfni = gfni }) ->
 +            let sse    = x86SseVersion sseAvx
 +                avx512 = x86Avx512Exts sseAvx
 +            in [ "+sse"     | sse >= SSE1  ]
 +            ++ [ "+sse2"    | sse >= SSE2  ]
 +            ++ [ "+sse3"    | sse >= SSE3  ]
 +            ++ [ "+ssse3"   | sse >= SSSE3 ]
 +            ++ [ "+sse4.1"  | sse >= SSE4  ]
 +            ++ [ "+sse4.2"  | sse >= SSE42 ]
 +            ++ [ "+popcnt"  | sse >= SSE42 ]
 +                 -- LLVM gates POPCNT instructions behind the popcnt flag,
 +                 -- while the GHC NCG (as well as GCC, Clang) gates it
 +                 -- behind SSE4.2 instead.
 +            ++ [ "+avx"     | x86AvxEnabled feats ]
 +            ++ [ "+avx2"    | x86Avx2Enabled feats ]
 +            ++ [ "+fma"     | x86FmaEnabled feats ]
 +            ++ ( case avx512 of
 +                   Nothing -> []
 +                   Just (Avx512Exts { avx512bw = bw, avx512cd = cd, avx512dq = dq
 +                                    , avx512er = er, avx512pf = pf, avx512vl = vl }) ->
 +                        [ "+avx512f" ]
 +                     ++ [ "+evex512" | maybe False (>= LlvmVersion (18 NE.:| [])) llvm_version ]
 +                          -- +evex512 is recognized by LLVM 18 or newer and needed on macOS (#26410).
 +                          -- It may become deprecated in a future LLVM version, though.
 +                     ++ [ "+avx512bw" | bw ]
 +                     ++ [ "+avx512cd" | cd ]
 +                     ++ [ "+avx512dq" | dq ]
 +                     ++ [ "+avx512er" | er ]
 +                     ++ [ "+avx512pf" | pf ]
 +                     ++ [ "+avx512vl" | vl ] )
 +            ++ [ "+bmi"     | bmi >= Just BMI1 ]
 +            ++ [ "+bmi2"    | bmi >= Just BMI2 ]
 +            ++ [ "+gfni"    | gfni ]
 +          GenericCpuFeatures { genericFma = fma } ->
 +            -- For AArch64 +fma is not a option (it's unconditionally available).
 +            [ "+fma" | fma && arch /= ArchAArch64 ]
          abi :: String
          abi = case platformArch (targetPlatform dflags) of

compiler/GHC/Driver/Session.hs

@@ -204,24 +204,8 @@ module GHC.Driver.Session (
          setUnsafeGlobalDynFlags,
 -        -- * SSE and AVX
 -        isSse3Enabled,
 -        isSsse3Enabled,
 -        isSse4_1Enabled,
 -        isSse4_2Enabled,
 -        isBmiEnabled,
 -        isBmi2Enabled,
 -        isAvxEnabled,
 -        isAvx2Enabled,
 -        isAvx512bwEnabled,
 -        isAvx512cdEnabled,
 -        isAvx512dqEnabled,
 -        isAvx512erEnabled,
 -        isAvx512fEnabled,
 -        isAvx512pfEnabled,
 -        isAvx512vlEnabled,
 -        isFmaEnabled,
 -        isGfniEnabled,
 +        -- * CPU features
 +        targetCpuFeatures,
          -- LoongArch: ISA version: la664, la464(default)
          isLa664Enabled,
@@ -241,6 +225,7 @@ module GHC.Driver.Session (
  import GHC.Prelude
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Platform.Ways
  import GHC.Platform.Profile
  import GHC.Platform.ArchOS
@@ -1724,40 +1709,6 @@ dynamic_flags_deps = [
          (setDumpFlag Opt_D_dump_faststrings)
          ------ Machine dependent (-m<blah>) stuff ---------------------------
 -        -- See Note [Implications between X86 CPU feature flags]
+-
 -  , make_ord_flag defGhcFlag "msse"         (noArg (\d ->
 -                                                  d { sseAvxVersion = max (Just SSE1) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "msse2"        (noArg (\d ->
 -                                                  d { sseAvxVersion = max (Just SSE2) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "msse3"        (noArg (\d ->
 -                                                  d { sseAvxVersion = max (Just SSE3) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "mssse3"       (noArg (\d ->
 -                                                  d { sseAvxVersion = max (Just SSSE3) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "msse4"        (noArg (\d ->
 -                                                  d { sseAvxVersion = max (Just SSE4) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "msse4.2"      (noArg (\d ->
 -                                                 d { sseAvxVersion = max (Just SSE42) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "mbmi"         (noArg (\d ->
 -                                                 d { bmiVersion = max (Just BMI1) (bmiVersion d) }))
 -  , make_ord_flag defGhcFlag "mbmi2"        (noArg (\d ->
 -                                                 d { bmiVersion = Just BMI2 }))
 -  , make_ord_flag defGhcFlag "mavx"         (noArg (\d ->
 -                                                 d { sseAvxVersion = max (Just AVX1) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "mavx2"        (noArg (\d ->
 -                                                 d { sseAvxVersion = max (Just AVX2) (sseAvxVersion d) }))
 -  , make_ord_flag defGhcFlag "mavx512bw"    (noArg (\d -> d { avx512bw = True }))
 -  , make_ord_flag defGhcFlag "mavx512cd"    (noArg (\d -> d { avx512cd = True }))
 -  , make_ord_flag defGhcFlag "mavx512dq"    (noArg (\d -> d { avx512dq = True }))
 -  , make_dep_flag defGhcFlag "mavx512er"    (noArg (\d -> d { avx512er = True }))
 -        "AVX-512ER was only available on Xeon Phi"
 -  , make_ord_flag defGhcFlag "mavx512f"     (noArg (\d -> d { avx512f = True }))
 -  , make_dep_flag defGhcFlag "mavx512pf"    (noArg (\d -> d { avx512pf = True }))
 -        "AVX-512PF was only available on Xeon Phi"
 -  , make_ord_flag defGhcFlag "mavx512vl"    (noArg (\d -> d { avx512vl = True }))
 -  , make_ord_flag defGhcFlag "mfma"         (noArg (\d -> d { fma = True }))
 -  , make_ord_flag defGhcFlag "mgfni"        (noArg (\d -> d { gfni = True }))
+-
    , make_ord_flag defGhcFlag "mla664"       (noArg (\d -> d { la664 = True }))
@@ -2021,6 +1972,11 @@ dynamic_flags_deps = [
           ------ Debugging flags ----------------------------------------------
    , make_ord_flag defGhcFlag "g"             (OptIntSuffix setDebugLevel)
+  ]
 +         ------ CPU features -------------------------------------------------
 + ++ map cpuFeatureFlagDep [minBound .. maxBound]
++
 +         ------ Negation -----------------------------------------------------
++
   ++ map (mkFlag turnOn  ""          setGeneralFlag    ) negatableFlagsDeps
   ++ map (mkFlag turnOff "no-"       unSetGeneralFlag  ) negatableFlagsDeps
   ++ map (mkFlag turnOn  "d"         setGeneralFlag    ) dFlagsDeps
@@ -2975,6 +2931,18 @@ optIntSuffixM fn = OptIntSuffix (\mi -> updM (fn mi))
  setDumpFlag :: DumpFlag -> OptKind (CmdLineP DynFlags)
  setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
 +setCpuFeature :: CpuFeature -> DynFlags -> DynFlags
 +setCpuFeature feat dflags = dflags { cpuFeatures = EnumSet.insert feat (cpuFeatures dflags) }
++
 +-- | The @-m\<feature\>@ flag for a 'CpuFeature'.
 +cpuFeatureFlagDep :: CpuFeature -> (Deprecation, Flag (CmdLineP DynFlags))
 +cpuFeatureFlagDep feat =
 +  case cpuFeatureFlag feat of
 +    (name, Nothing ) -> make_ord_flag defGhcFlag ('m' : name) set
 +    (name, Just msg) -> make_dep_flag defGhcFlag ('m' : name) set msg
 +  where
 +    set = noArg (setCpuFeature feat)
++
  --------------------------
  addWayDynP :: Way -> DynP ()
  addWayDynP = upd . addWay'

compiler/GHC/Platform.hs

@@ -29,12 +29,7 @@ module GHC.Platform
     , platformCConvNeedsExtension
     , platformHasRTSLinker
     , PlatformMisc(..)
 -   , SseAvxVersion (..)
 -   , BmiVersion (..)
     , wordAlignment
 -   -- * SSE and AVX
 -   , isSseEnabled
 -   , isSse2Enabled
     -- * Platform constants
     , PlatformConstants(..)
     , lookupPlatformConstants
@@ -116,33 +111,6 @@ data Platform = Platform
  wordAlignment :: Platform -> Alignment
  wordAlignment platform = alignmentOf (platformWordSizeInBytes platform)
 --- -----------------------------------------------------------------------------
 --- SSE and AVX
+-
 --- TODO: Instead of using a separate predicate (i.e. isSse2Enabled) to
 --- check if SSE is enabled, we might have x86-64 imply the -msse2
 --- flag.
+-
 -isSseEnabled :: Platform -> Bool
 -isSseEnabled platform = case platformArch platform of
 -    ArchX86_64 -> True
 -    ArchX86    -> True
 -    _          -> False
+-
 -isSse2Enabled :: Platform -> Bool
 -isSse2Enabled platform = case platformArch platform of
 -  -- We assume  SSE1 and SSE2 operations are available on both
 -  -- x86 and x86_64. Historically we didn't default to SSE2 and
 -  -- SSE1 on x86, which results in defacto nondeterminism for how
 -  -- rounding behaves in the associated x87 floating point instructions
 -  -- because variations in the spill/fpu stack placement of arguments for
 -  -- operations would change the precision and final result of what
 -  -- would otherwise be the same expressions with respect to single or
 -  -- double precision IEEE floating point computations.
 -    ArchX86_64 -> True
 -    ArchX86    -> True
 -    _          -> False
+-
  -- -----------------------------------------------------------------------------
  -- Platform Constants
@@ -279,28 +247,6 @@ platformHasRTSLinker p = case archOS_arch (platformArchOS p) of
 ---------------------------------------------------
 --- Instruction sets
 ---------------------------------------------------
+-
 --- | x86 SSE and AVX instructions
 -data SseAvxVersion
 -   = SSE1
 -   | SSE2
 -   | SSE3
 -   | SSSE3
 -   | SSE4
 -   | SSE42
 -   | AVX1
 -   | AVX2
 -   deriving (Eq, Ord)
+-
 --- | x86 BMI (bit manipulation) instructions
 -data BmiVersion
 -   = BMI1
 -   | BMI2
 -   deriving (Eq, Ord)
+-
  -- | Platform-specific settings formerly hard-coded in Config.hs.
  --
  -- These should probably be all be triaged whether they can be computed from

compiler/GHC/Platform/CpuFeatures.hs

 +{-# LANGUAGE LambdaCase #-}
++
 +-- | CPU features and corresponding @-m\<feature\>@ flags.
 +--
 +-- See Note [CPU features].
 +module GHC.Platform.CpuFeatures
 +  ( -- * Feature flags
 +    CpuFeature (..)
 +  , cpuFeatureFlag
++
 +    -- * Enabled instruction sets
 +  , CpuFeatures (..)
 +  , initCpuFeatures
 +  , cpuFmaEnabled
++
 +    -- ** x86
 +  , X86Features (..)
 +  , SseAvxVersion (..)
 +  , AvxLevel (..)
 +  , x86SseVersion
 +  , x86Avx512Exts
 +  , sseAvxVersionIncludes
 +  , unionSseAvxVersion
 +  , sseAvxVectorRequirement
 +  , x86BaselineSseAvx
 +  , sseAvxVersionFlags
 +  , SseVersion (..)
 +  , Avx512Exts (..)
 +  , noAvx512Exts
 +  , BmiVersion (..)
++
 +    -- *** Querying x86 features
 +    -- | These are not independent; see Note [CPU features].
 +  , x86Ssse3Enabled
 +  , x86Sse4_1Enabled
 +  , x86Sse4_2Enabled
 +  , x86AvxEnabled
 +  , x86Avx2Enabled
 +  , x86FmaEnabled
 +  , x86Avx512FEnabled
 +  , x86Avx512DQEnabled
 +  , x86Avx512VLEnabled
 +  , x86Bmi2Enabled
 +  )
 +where
++
 +import GHC.Prelude
++
 +import GHC.Platform.ArchOS
 +import GHC.Data.EnumSet (EnumSet)
 +import qualified GHC.Data.EnumSet as EnumSet
++
 +import Data.Maybe (isJust)
++
 +{- Note [CPU features]
 +~~~~~~~~~~~~~~~~~~~~~~
 +The -m<feature> flags enable CPU instruction set extensions. Many of them imply
 +others:
++
 +  1. AVX2 -> AVX -> SSE4.2 -> SSE4 -> SSSE3 -> SSE3 -> SSE2 -> SSE1
 +  2. BMI2 -> BMI1
 +  3. FMA -> AVX    (on X86)
 +  4. AVX512{BW,CD,DQ,ER,PF,VL} -> AVX512F -> AVX2 + FMA
++
 +We keep two representations:
++
 +  A. 'DynFlags' records the set of flags that were passed, as an
 +     'EnumSet' of 'CpuFeature'. Nothing is implied at this stage.
++
 +  B. 'initCpuFeatures' turns this set into a 'CpuFeatures' value, applying the
 +     implications and the baseline of the target architecture. This
 +     representation makes the implications structural: 'SseAvxVersion' is a
 +     point in the total order (1), FMA can only be recorded together with AVX,
 +     and AVX-512 sits above AVX2 and FMA.
++
 +Code generation and the driver only consult the second representation, so
 +whether an instruction set is enabled is decided in one place.
 +-}
++
 +-- | A CPU feature flag, @-m\<feature\>@.
 +data CpuFeature
 +  = Feat_SSE
 +  | Feat_SSE2
 +  | Feat_SSE3
 +  | Feat_SSSE3
 +  | Feat_SSE4
 +  | Feat_SSE4_2
 +  | Feat_AVX
 +  | Feat_AVX2
 +  | Feat_AVX512F
 +  | Feat_AVX512BW
 +  | Feat_AVX512CD
 +  | Feat_AVX512DQ
 +  | Feat_AVX512ER
 +  | Feat_AVX512PF
 +  | Feat_AVX512VL
 +  | Feat_FMA
 +  | Feat_BMI
 +  | Feat_BMI2
 +  | Feat_GFNI
 +  deriving (Eq, Show, Enum, Bounded)
++
 +-- | The name of the @-m\<feature\>@ flag for a 'CpuFeature' (without the
 +-- leading @m@).
 +--
 +-- Additionally returns an optional deprecation message.
 +cpuFeatureFlag :: CpuFeature -> (String, Maybe String)
 +cpuFeatureFlag = \case
 +  Feat_SSE      -> ("sse"      , Nothing)
 +  Feat_SSE2     -> ("sse2"     , Nothing)
 +  Feat_SSE3     -> ("sse3"     , Nothing)
 +  Feat_SSSE3    -> ("ssse3"    , Nothing)
 +  Feat_SSE4     -> ("sse4"     , Nothing)
 +  Feat_SSE4_2   -> ("sse4.2"   , Nothing)
 +  Feat_AVX      -> ("avx"      , Nothing)
 +  Feat_AVX2     -> ("avx2"     , Nothing)
 +  Feat_AVX512F  -> ("avx512f"  , Nothing)
 +  Feat_AVX512BW -> ("avx512bw" , Nothing)
 +  Feat_AVX512CD -> ("avx512cd" , Nothing)
 +  Feat_AVX512DQ -> ("avx512dq" , Nothing)
 +  Feat_AVX512ER -> ("avx512er" , Just "AVX-512ER was only available on Xeon Phi")
 +  Feat_AVX512PF -> ("avx512pf" , Just "AVX-512PF was only available on Xeon Phi")
 +  Feat_AVX512VL -> ("avx512vl" , Nothing)
 +  Feat_FMA      -> ("fma"      , Nothing)
 +  Feat_BMI      -> ("bmi"      , Nothing)
 +  Feat_BMI2     -> ("bmi2"     , Nothing)
 +  Feat_GFNI     -> ("gfni"     , Nothing)
++
 +-- | The CPU features that are enabled for the target.
 +--
 +-- See Note [CPU features].
 +data CpuFeatures
 +  -- | x86 and x86_64 CPU features.
 +  = X86CpuFeatures !X86Features
 +  -- | A generic set of CPU features.
 +  --
 +  -- For now, code generation for non-X86 architectures assumes a fixed
 +  -- baseline ISA, with the only exception of FMA support.
 +  --
 +  -- In the future, we can add architecture-specific constructors, e.g. for
 +  -- RISC-V (vector support, bit manipulation, etc).
 +  | GenericCpuFeatures
 +    { genericFma :: !Bool -- ^ are FMA operations enabled?
 +    }
 +  deriving (Eq, Show)
++
 +-- | The CPU features enabled by the given flags on the given architecture.
 +--
 +-- See Note [CPU features].
 +initCpuFeatures :: Arch -> EnumSet CpuFeature -> CpuFeatures
 +initCpuFeatures arch feats = case arch of
 +  ArchX86     -> X86CpuFeatures (initX86Features feats)
 +  ArchX86_64  -> X86CpuFeatures (initX86Features feats)
 +  -- AArch64 always has fused multiply-add instructions.
 +  ArchAArch64 -> GenericCpuFeatures { genericFma = True }
 +  _           -> GenericCpuFeatures { genericFma = EnumSet.member Feat_FMA feats }
++
 +-- | Whether fused multiply-add instructions are enabled.
 +cpuFmaEnabled :: CpuFeatures -> Bool
 +cpuFmaEnabled = \case
 +  X86CpuFeatures feats                    -> x86FmaEnabled feats
 +  GenericCpuFeatures { genericFma = fma } -> fma
++
 +--------------------------------------------------------------------------------
 +-- x86
++
 +-- | The x86 CPU features that are enabled.
 +data X86Features = X86Features
 +  { x86SseAvx :: !SseAvxVersion
 +  , x86Bmi    :: !(Maybe BmiVersion)
 +  , x86Gfni   :: !Bool
 +  }
 +  deriving (Eq, Show)
++
 +-- | Enabled SSE/AVX instruction sets, and whether FMA is enabled.
 +--
 +-- See Note [CPU features].
 +data SseAvxVersion
 +  -- | SSE, but no AVX (and thus no FMA).
 +  = Sse !SseVersion
 +  -- | AVX, and potentially more (AVX2, FMA, etc).
 +  | Avx !AvxLevel
 +  deriving (Eq, Show)
 +-- NB: no 'Ord' instance, as this is only a partial order.
 +-- See 'sseAvxVersionIncludes'.
++
 +-- | Level of enabled AVX instruction sets, and whether FMA is enabled.
 +data AvxLevel
 +  -- | AVX (with or without FMA).
 +  = Avx1 { avxFma :: !Bool }
 +  -- | AVX2 (with or without FMA).
 +  | Avx2 { avxFma :: !Bool }
 +  -- | AVX-512F (which includes AVX2 and FMA), with the given extensions.
 +  | Avx512 !Avx512Exts
 +  deriving (Eq, Show)
++
 +-- | x86 SSE instruction sets (each including the previous ones).
 +data SseVersion
 +  = SSE1
 +  | SSE2
 +  | SSE3
 +  | SSSE3
 +  | SSE4
 +  | SSE42
 +  deriving (Eq, Ord, Show)
++
 +-- | The AVX-512 extensions beyond AVX-512F.
 +data Avx512Exts = Avx512Exts
 +  { avx512bw :: !Bool -- ^ byte and word operations
 +  , avx512cd :: !Bool -- ^ conflict detection
 +  , avx512dq :: !Bool -- ^ doubleword and quadword operations
 +  , avx512er :: !Bool -- ^ exponential and reciprocal
 +  , avx512pf :: !Bool -- ^ prefetch
 +  , avx512vl :: !Bool -- ^ AVX-512 instructions on 128-bit and 256-bit vectors
 +  }
 +  deriving (Eq, Show)
++
 +noAvx512Exts :: Avx512Exts
 +noAvx512Exts = Avx512Exts False False False False False False
++
 +-- | x86 BMI (bit manipulation) instruction sets (BMI2 including BMI1).
 +data BmiVersion
 +  = BMI1
 +  | BMI2
 +  deriving (Eq, Ord, Show)
++
++
 +-- | The baseline ISA that we assume for both x86 and x86_64: SSE2.
 +--
 +-- Historical remark: prior to GHC 8.10, we used to not require SSE2 on 32-bit
 +-- x86 architectures. This resulted in defacto nondeterminism for rounding
 +-- behaviour due to oddities of the x87 stack-based floating-point implementation.
 +x86BaselineSseAvx :: SseAvxVersion
 +x86BaselineSseAvx = Sse SSE2
++
 +-- | Enable the user-specified features, on top of the X86 baseline feature set
 +-- ('x86BaselineSseAvx').
 +--
 +-- The implication structure of CPU feature flags is detailed in Note [CPU features].
 +initX86Features
 +  :: EnumSet CpuFeature -- ^ user-enabled features
 +  -> X86Features
 +initX86Features feats = X86Features
 +  { x86SseAvx = sseAvx
 +  , x86Bmi    = bmi
 +  , x86Gfni   = has Feat_GFNI
 +  }
 +  where
 +    has = (`EnumSet.member` feats)
 +    fma = has Feat_FMA
 +    avx512 = Avx512Exts
 +      { avx512bw = has Feat_AVX512BW
 +      , avx512cd = has Feat_AVX512CD
 +      , avx512dq = has Feat_AVX512DQ
 +      , avx512er = has Feat_AVX512ER
 +      , avx512pf = has Feat_AVX512PF
 +      , avx512vl = has Feat_AVX512VL
 +      }
 +    sseAvx
 +      | has Feat_AVX512F || avx512 /= noAvx512Exts = Avx (Avx512 avx512)
 +      | has Feat_AVX2                              = Avx (Avx2 fma)
 +      | has Feat_AVX || fma                        = Avx (Avx1 fma)
 +      | has Feat_SSE4_2                            = Sse SSE42
 +      | has Feat_SSE4                              = Sse SSE4
 +      | has Feat_SSSE3                             = Sse SSSE3
 +      | has Feat_SSE3                              = Sse SSE3
 +      | otherwise                                  = x86BaselineSseAvx
 +    bmi
 +      | has Feat_BMI2 = Just BMI2
 +      | has Feat_BMI  = Just BMI1
 +      | otherwise     = Nothing
++
 +x86SseVersion :: SseAvxVersion -> SseVersion
 +x86SseVersion = \case
 +  Sse v -> v
 +  Avx _ -> SSE42
++
 +x86Avx512Exts :: SseAvxVersion -> Maybe Avx512Exts
 +x86Avx512Exts = \case
 +  Avx (Avx512 exts) -> Just exts
 +  _                 -> Nothing
++
 +--------------------------------------------------------------------------------
 +-- Querying x86 features
++
 +-- NB: the predicates below are not independent, because there are implications
 +-- between feature flags (e.g. AVX2 implies SSE4.2).
 +--
 +-- See Note [CPU features].
++
 +x86Ssse3Enabled :: X86Features -> Bool
 +x86Ssse3Enabled = (>= SSSE3) . x86SseVersion . x86SseAvx
++
 +x86Sse4_1Enabled :: X86Features -> Bool
 +x86Sse4_1Enabled = (>= SSE4) . x86SseVersion . x86SseAvx
++
 +x86Sse4_2Enabled :: X86Features -> Bool
 +x86Sse4_2Enabled = (>= SSE42) . x86SseVersion . x86SseAvx
++
 +x86AvxEnabled :: X86Features -> Bool
 +x86AvxEnabled feats = case x86SseAvx feats of
 +  Sse _ -> False
 +  Avx _ -> True
++
 +x86Avx2Enabled :: X86Features -> Bool
 +x86Avx2Enabled feats = case x86SseAvx feats of
 +  Sse _          -> False
 +  Avx (Avx1 _)   -> False
 +  Avx (Avx2 _)   -> True
 +  Avx (Avx512 _) -> True
++
 +x86FmaEnabled :: X86Features -> Bool
 +x86FmaEnabled feats = case x86SseAvx feats of
 +  Sse _            -> False
 +  Avx (Avx1 fma)   -> fma
 +  Avx (Avx2 fma)   -> fma
 +  Avx (Avx512 _)   -> True
++
 +x86Avx512FEnabled :: X86Features -> Bool
 +x86Avx512FEnabled = isJust . x86Avx512Exts . x86SseAvx
++
 +x86Avx512DQEnabled :: X86Features -> Bool
 +x86Avx512DQEnabled = maybe False avx512dq . x86Avx512Exts . x86SseAvx
++
 +x86Avx512VLEnabled :: X86Features -> Bool
 +x86Avx512VLEnabled = maybe False avx512vl . x86Avx512Exts . x86SseAvx
++
 +x86Bmi2Enabled :: X86Features -> Bool
 +x86Bmi2Enabled = (>= Just BMI2) . x86Bmi
++
 +--------------------------------------------------------------------------------
 +-- Comparing x86 feature sets
++
 +-- | @enabled \`sseAvxVersionIncludes\` required@ answers whether the @enabled@
 +-- features provide everything required by @required@, taking into account
 +-- implications between instruction sets. See Note [CPU features].
 +--
 +-- This is a partial order, as FMA and the AVX-512 extensions are independent
 +-- of each other.
 +sseAvxVersionIncludes :: SseAvxVersion -> SseAvxVersion -> Bool
 +sseAvxVersionIncludes enabled required = case (enabled, required) of
 +  (Sse e, Sse r) -> e >= r
 +  (Avx _, Sse _) -> True
 +  (Sse _, Avx _) -> False
 +  (Avx e, Avx r) -> e `avxLevelIncludes` r
 +  where
 +    avxLevelIncludes :: AvxLevel -> AvxLevel -> Bool
 +    avxLevelIncludes e r = case (e, r) of
 +      (Avx512 ee, Avx512 re) -> ee `avx512ExtsInclude` re
 +      (Avx512 _, _)          -> True
 +      (_, Avx512 _)          -> False
 +      (Avx1 ef, Avx1 rf)     -> rf `implies` ef
 +      (Avx2 ef, Avx1 rf)     -> rf `implies` ef
 +      (Avx2 ef, Avx2 rf)     -> rf `implies` ef
 +      (Avx1 _, Avx2 _)       -> False
++
 +    avx512ExtsInclude :: Avx512Exts -> Avx512Exts -> Bool
 +    avx512ExtsInclude
 +      (Avx512Exts ebw ecd edq eer epf evl)
 +      (Avx512Exts rbw rcd rdq rer rpf rvl)
 +      =  rbw `implies` ebw
 +      && rcd `implies` ecd
 +      && rdq `implies` edq
 +      && rer `implies` eer
 +      && rpf `implies` epf
 +      && rvl `implies` evl
++
 +    implies :: Bool -> Bool -> Bool
 +    implies a b = b || not a
++
 +-- | The least 'SseAvxVersion' providing everything that both arguments do.
 +unionSseAvxVersion :: SseAvxVersion -> SseAvxVersion -> SseAvxVersion
 +unionSseAvxVersion v1 v2 = case (v1, v2) of
 +  (Sse a, Sse b) -> Sse (max a b)
 +  (Sse _, Avx _) -> v2
 +  (Avx _, Sse _) -> v1
 +  (Avx a, Avx b) -> Avx (a `avxLevelJoin` b)
 +  where
 +    avxLevelJoin :: AvxLevel -> AvxLevel -> AvxLevel
 +    avxLevelJoin a b = case (a, b) of
 +      (Avx512 ea, Avx512 eb) -> Avx512 (ea `avx512ExtsUnion` eb)
 +      (Avx512 _, _)          -> a
 +      (_, Avx512 _)          -> b
 +      (Avx1 fa, Avx1 fb)     -> Avx1 (fa || fb)
 +      (Avx1 fa, Avx2 fb)     -> Avx2 (fa || fb)
 +      (Avx2 fa, Avx1 fb)     -> Avx2 (fa || fb)
 +      (Avx2 fa, Avx2 fb)     -> Avx2 (fa || fb)
 +    avx512ExtsUnion (Avx512Exts bw1 cd1 dq1 er1 pf1 vl1) (Avx512Exts bw2 cd2 dq2 er2 pf2 vl2)
 +      = Avx512Exts (bw1 || bw2) (cd1 || cd2) (dq1 || dq2) (er1 || er2) (pf1 || pf2) (vl1 || vl2)
++
 +-- | The SSE/AVX instruction sets required to operate on vectors of the given
 +-- width in bits, with floating-point or integer elements.
 +--
 +-- 128-bit vectors need SSE2 (SSE1 only covers single-precision elements).
 +sseAvxVectorRequirement
 +  :: Bool -- ^ floating-point elements?
 +  -> Int  -- ^ width of the vector, in bits
 +  -> SseAvxVersion
 +sseAvxVectorRequirement float bits
 +  | bits <= 128 = Sse SSE2
 +  | bits <= 256 = Avx $ if float then Avx1 False else Avx2 False
 +  | otherwise   = Avx $ Avx512 noAvx512Exts
++
 +-- | A minimal set of flags that imply the given 'SseAvxVersion'.
 +sseAvxVersionFlags :: SseAvxVersion -> [String]
 +sseAvxVersionFlags = \case
 +  Sse v ->
 +    [ case v of
 +        SSE1  -> "-msse"
 +        SSE2  -> "-msse2"
 +        SSE3  -> "-msse3"
 +        SSSE3 -> "-mssse3"
 +        SSE4  -> "-msse4"
 +        SSE42 -> "-msse4.2"
 +    ]
 +  Avx (Avx1 fma)
 +    | fma       -> [ "-mfma" ] -- FMA implies AVX
 +    | otherwise -> [ "-mavx" ]
 +  Avx (Avx2 fma) -> "-mavx2" : [ "-mfma" | fma ]
 +  Avx (Avx512 (Avx512Exts bw cd dq er pf vl))
 +    -- Every AVX-512 extension implies AVX-512F
 +    | null exts -> [ "-mavx512f" ]
 +    | otherwise -> exts
 +    where
 +      exts =
 +        [ flag
 +        | (flag, enabled) <-
 +            [ ("-mavx512bw", bw)
 +            , ("-mavx512cd", cd)
 +            , ("-mavx512dq", dq)
 +            , ("-mavx512er", er)
 +            , ("-mavx512pf", pf)
 +            , ("-mavx512vl", vl)
 +            ]
 +        , enabled ]

compiler/GHC/StgToCmm/Config.hs

@@ -7,6 +7,7 @@ module GHC.StgToCmm.Config
  import GHC.Platform.Profile
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Unit.Module
  import GHC.Utils.Outputable
  import GHC.Utils.TmpFs
@@ -76,16 +77,9 @@ data StgToCmmConfig = StgToCmmConfig
    , stgToCmmUseStdApThunk             :: !Bool   -- ^ Use precomputed standard AP thunks in the RTS.
    , stgToCmmSaveFCallTargetToLocal    :: !Bool   -- ^ Save a foreign call target to a Cmm local, see
                                                   -- Note [Saving foreign call target to local] for details
 -  ------------------------------ SIMD flags ------------------------------------
 -  -- Each of these flags checks vector compatibility with the backend requested
 -  -- during compilation. In essence, this means checking for @-fllvm@ which is
 -  -- the only backend that currently allows SIMD instructions, see
 -  -- Ghc.StgToCmm.Prim.checkVecCompatibility for these flags only call site.
    , stgToCmmVecInstrsErr   :: Maybe String       -- ^ Error (if any) to raise when vector instructions are
                                                   -- used, see @StgToCmm.Prim.checkVecCompatibility@
 -  , stgToCmmAvx            :: !Bool              -- ^ check for Advanced Vector Extensions
 -  , stgToCmmAvx2           :: !Bool              -- ^ check for Advanced Vector Extensions 2
 -  , stgToCmmAvx512f        :: !Bool              -- ^ check for Advanced Vector 512-bit Extensions
 +  , stgToCmmCpuFeatures    :: !CpuFeatures       -- ^ Enabled CPU features
+   }

compiler/GHC/StgToCmm/Prim.hs

@@ -18,6 +18,7 @@ module GHC.StgToCmm.Prim (
  import GHC.Prelude hiding ((<*>))
  import GHC.Platform
 +import GHC.Platform.CpuFeatures
  import GHC.Platform.Profile
  import GHC.StgToCmm.Config
@@ -2688,45 +2689,44 @@ vecCmmCat FloatVec = cmmFloat
  --    it may very well be a design perspective that helps guide improving the NCG.
 +-- | Give up if the backend or the enabled CPU features do not support
 +-- operations on vectors of the given category, length and element width.
  checkVecCompatibility :: StgToCmmConfig -> PrimOpVecCat -> Length -> Width -> FCode ()
  checkVecCompatibility cfg vcat l w =
 -  case stgToCmmVecInstrsErr cfg of
 -    Nothing | isX86 -> checkX86 vecWidth vcat l w
 -            | platformArch platform == ArchAArch64 -> checkAArch64 vecWidth
 -            | otherwise -> sorry "SIMD vector instructions are not supported on this architecture."
 -    Just err -> sorry err  -- incompatible backend, do panic
 +  case unsupported of
 +    Nothing     -> return ()
 +    Just reason -> sorry reason
    where
 -    platform = stgToCmmPlatform cfg
 -    isX86 = case platformArch platform of
 -      ArchX86_64 -> True
 -      ArchX86 -> True
 -      _ -> False
 -    checkX86 :: Width -> PrimOpVecCat -> Length -> Width -> FCode ()
 -    checkX86 W128 FloatVec 4 W32 | isSseEnabled platform = return ()
 -                                 | otherwise =
 -        sorry $ "128-bit wide single-precision floating point " ++
 -                "SIMD vector instructions require at least -msse."
 -    checkX86 W128 _ _ _ | not (isSse2Enabled platform) =
 -        sorry $ "128-bit wide integer and double precision " ++
 -                "SIMD vector instructions require at least -msse2."
 -    checkX86 W256 FloatVec _ _ | stgToCmmAvx cfg = return ()
 -                               | otherwise =
 -        sorry $ "256-bit wide floating point " ++
 -                "SIMD vector instructions require at least -mavx."
 -    checkX86 W256 _ _ _ | not (stgToCmmAvx2 cfg) =
 -        sorry $ "256-bit wide integer " ++
 -                "SIMD vector instructions require at least -mavx2."
 -    checkX86 W512 _ _ _ | not (stgToCmmAvx512f cfg) =
 -        sorry $ "512-bit wide " ++
 -                "SIMD vector instructions require -mavx512f."
 -    checkX86 _ _ _ _ = return ()
+-
 -    checkAArch64 :: Width -> FCode ()
 -    checkAArch64 W256 = sorry $ "256-bit wide SIMD vector instructions are not supported."
 -    checkAArch64 W512 = sorry $ "512-bit wide SIMD vector instructions are not supported."
 -    checkAArch64 _ = return ()
 +    unsupported :: Maybe String
 +    unsupported
 +      -- The backend does not support vector instructions at all.
 +      | Just err <- stgToCmmVecInstrsErr cfg
 +      = Just err
 +      | otherwise
 +      = case stgToCmmCpuFeatures cfg of
 +          X86CpuFeatures feats
 +            | x86SseAvx feats `sseAvxVersionIncludes` required
 +            -> Nothing
 +            | otherwise
 +            -> Just $ bits ++ "-bit wide " ++ category ++ " SIMD vector instructions require at least "
 +                   ++ unwords (sseAvxVersionFlags required) ++ "."
 +            where required = sseAvxVectorRequirement floatElems (widthInBits vecWidth)
 +          _ | platformArch (stgToCmmPlatform cfg) == ArchAArch64
 +            -> case vecWidth of
 +                 W128 -> Nothing
 +                 _    -> Just $ bits ++ "-bit wide SIMD vector instructions are not supported."
 +            | otherwise
 +            -> Just "SIMD vector instructions are not supported on this architecture."
      vecWidth = typeWidth (vecCmmType vcat l w)
 +    bits = show (widthInBits vecWidth)
 +    floatElems = case vcat of
 +      FloatVec -> True
 +      IntVec   -> False
 +      WordVec  -> False
 +    category
 +      | floatElems = "floating-point"
 +      | otherwise  = "integer"
  ------------------------------------------------------------------------------
  -- Helpers for translating vector packing and unpacking.

compiler/GHC/SysTools/Cpp.hs

@@ -18,6 +18,7 @@ import GHC.Driver.Backend
  import GHC.CmmToLlvm.Version
  import GHC.Platform
  import GHC.Platform.ArchOS
 +import GHC.Platform.CpuFeatures
  import GHC.SysTools
@@ -151,30 +152,30 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
            [ "-D__IO_MANAGER_WINIO__=2" | isWindows ] ++
            [ "-D__IO_MANAGER_MIO__=1"               ]
 -    let sse_defs =
 -          [ "-D__SSE__"      | isSseEnabled      platform ] ++
 -          [ "-D__SSE2__"     | isSse2Enabled     platform ] ++
 -          [ "-D__SSE3__"     | isSse3Enabled     dflags ] ++
 -          [ "-D__SSSE3__"    | isSsse3Enabled    dflags ] ++
 -          [ "-D__SSE4_1__"   | isSse4_1Enabled   dflags ] ++
 -          [ "-D__SSE4_2__"   | isSse4_2Enabled   dflags ]
+-
 -    let fma_def =
 -         [ "-D__FMA__"       | isFmaEnabled dflags ]
+-
 -    let avx_defs =
 -          [ "-D__AVX__"      | isAvxEnabled      dflags ] ++
 -          [ "-D__AVX2__"     | isAvx2Enabled     dflags ] ++
 -          [ "-D__AVX512BW__" | isAvx512bwEnabled dflags ] ++
 -          [ "-D__AVX512CD__" | isAvx512cdEnabled dflags ] ++
 -          [ "-D__AVX512DQ__" | isAvx512dqEnabled dflags ] ++
 -          [ "-D__AVX512ER__" | isAvx512erEnabled dflags ] ++
 -          [ "-D__AVX512F__"  | isAvx512fEnabled  dflags ] ++
 -          [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ] ++
 -          [ "-D__AVX512VL__" | isAvx512vlEnabled dflags ]
+-
 -    let gfni_def =
 -          [ "-D__GFNI__"     | isGfniEnabled dflags ]
 +    let cpu_feats = targetCpuFeatures dflags
 +        cpu_defs =
 +          [ "-D__FMA__" | cpuFmaEnabled cpu_feats ] ++
 +          case cpu_feats of
 +            X86CpuFeatures feats@(X86Features { x86SseAvx = sseAvx, x86Gfni = gfni }) ->
 +              let sse    = x86SseVersion sseAvx
 +                  avx512 = x86Avx512Exts sseAvx
 +              in [ "-D__SSE__"      | sse >= SSE1  ] ++
 +                 [ "-D__SSE2__"     | sse >= SSE2  ] ++
 +                 [ "-D__SSE3__"     | sse >= SSE3  ] ++
 +                 [ "-D__SSSE3__"    | sse >= SSSE3 ] ++
 +                 [ "-D__SSE4_1__"   | sse >= SSE4  ] ++
 +                 [ "-D__SSE4_2__"   | sse >= SSE42 ] ++
 +                 [ "-D__AVX__"      | x86AvxEnabled feats ] ++
 +                 [ "-D__AVX2__"     | x86Avx2Enabled feats ] ++
 +                 [ "-D__AVX512F__"  | isJust avx512 ] ++
 +                 [ "-D__AVX512BW__" | maybe False avx512bw avx512 ] ++
 +                 [ "-D__AVX512CD__" | maybe False avx512cd avx512 ] ++
 +                 [ "-D__AVX512DQ__" | maybe False avx512dq avx512 ] ++
 +                 [ "-D__AVX512ER__" | maybe False avx512er avx512 ] ++
 +                 [ "-D__AVX512PF__" | maybe False avx512pf avx512 ] ++
 +                 [ "-D__AVX512VL__" | maybe False avx512vl avx512 ] ++
 +                 [ "-D__GFNI__"     | gfni ]
 +            GenericCpuFeatures {} -> []
      backend_defs <- applyCDefs (backendCDefs $ backend dflags) logger dflags
@@ -212,10 +213,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
                      ++ map GHC.SysTools.Option th_defs
                      ++ map GHC.SysTools.Option asserts_def
                      ++ map GHC.SysTools.Option hscpp_opts
 -                    ++ map GHC.SysTools.Option sse_defs
 -                    ++ map GHC.SysTools.Option fma_def
 -                    ++ map GHC.SysTools.Option avx_defs
 -                    ++ map GHC.SysTools.Option gfni_def
 +                    ++ map GHC.SysTools.Option cpu_defs
                      ++ map GHC.SysTools.Option io_manager_defs
                      ++ mb_macro_include
                      ++ line_pragmas

compiler/ghc.cabal.in

@@ -689,6 +689,7 @@ Library
          GHC.Platform.ARM
          GHC.Platform.AArch64
          GHC.Platform.Constants
 +        GHC.Platform.CpuFeatures
          GHC.Platform.LA64
          GHC.Platform.NoRegs
          GHC.Platform.PPC

testsuite/tests/count-deps/CountDepsParser.stdout

@@ -150,6 +150,7 @@ GHC.Parser.String
  GHC.Parser.Types
  GHC.Platform
  GHC.Platform.Constants
 +GHC.Platform.CpuFeatures
  GHC.Platform.Profile
  GHC.Platform.Tag
  GHC.Platform.Ways