From 86ce92a2f81a04aa980da2891d0e300cb3cb7efd Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 22 Aug 2023 13:06:50 -0400
Subject: [PATCH] compiler: Move platform feature predicates to
GHC.Driver.DynFlags
These are useful in `GHC.Driver.Config.*`.
---
compiler/GHC/Driver/DynFlags.hs | 54 +++++++++++++++++++++++++++++++++
compiler/GHC/Driver/Session.hs | 42 -------------------------
2 files changed, 54 insertions(+), 42 deletions(-)
diff --git a/compiler/GHC/Driver/DynFlags.hs b/compiler/GHC/Driver/DynFlags.hs
index e206f5acb5b5..7bf3341b404e 100644
--- a/compiler/GHC/Driver/DynFlags.hs
+++ b/compiler/GHC/Driver/DynFlags.hs
@@ -71,6 +71,18 @@ module GHC.Driver.DynFlags (
-- * SDoc
initSDocContext, initDefaultSDocContext,
initPromotionTickContext,
+
+ -- * Platform features
+ isSse4_2Enabled,
+ isAvxEnabled,
+ isAvx2Enabled,
+ isAvx512cdEnabled,
+ isAvx512erEnabled,
+ isAvx512fEnabled,
+ isAvx512pfEnabled,
+ isFmaEnabled,
+ isBmiEnabled,
+ isBmi2Enabled
) where
import GHC.Prelude
@@ -1521,3 +1533,45 @@ initPromotionTickContext dflags =
ptcListTuplePuns = True,
ptcPrintRedundantPromTicks = gopt Opt_PrintRedundantPromotionTicks dflags
}
+
+-- -----------------------------------------------------------------------------
+-- SSE, AVX, FMA
+
+isSse4_2Enabled :: DynFlags -> Bool
+isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
+
+isAvxEnabled :: DynFlags -> Bool
+isAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags
+
+isAvx2Enabled :: DynFlags -> Bool
+isAvx2Enabled dflags = avx2 dflags || avx512f dflags
+
+isAvx512cdEnabled :: DynFlags -> Bool
+isAvx512cdEnabled dflags = avx512cd dflags
+
+isAvx512erEnabled :: DynFlags -> Bool
+isAvx512erEnabled dflags = avx512er dflags
+
+isAvx512fEnabled :: DynFlags -> Bool
+isAvx512fEnabled dflags = avx512f dflags
+
+isAvx512pfEnabled :: DynFlags -> Bool
+isAvx512pfEnabled dflags = avx512pf dflags
+
+isFmaEnabled :: DynFlags -> Bool
+isFmaEnabled dflags = fma 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
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 557af56d6c0a..0ed06940087f 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3727,48 +3727,6 @@ setUnsafeGlobalDynFlags dflags = do
writeIORef v_unsafeHasNoStateHack (hasNoStateHack dflags)
--- -----------------------------------------------------------------------------
--- SSE, AVX, FMA
-
-isSse4_2Enabled :: DynFlags -> Bool
-isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42
-
-isAvxEnabled :: DynFlags -> Bool
-isAvxEnabled dflags = avx dflags || avx2 dflags || avx512f dflags
-
-isAvx2Enabled :: DynFlags -> Bool
-isAvx2Enabled dflags = avx2 dflags || avx512f dflags
-
-isAvx512cdEnabled :: DynFlags -> Bool
-isAvx512cdEnabled dflags = avx512cd dflags
-
-isAvx512erEnabled :: DynFlags -> Bool
-isAvx512erEnabled dflags = avx512er dflags
-
-isAvx512fEnabled :: DynFlags -> Bool
-isAvx512fEnabled dflags = avx512f dflags
-
-isAvx512pfEnabled :: DynFlags -> Bool
-isAvx512pfEnabled dflags = avx512pf dflags
-
-isFmaEnabled :: DynFlags -> Bool
-isFmaEnabled dflags = fma 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
-
-- -----------------------------------------------------------------------------
-- | Indicate if cost-centre profiling is enabled
--
GitLab