cpu-features (empty) → 0.1.0.0

raw patch · 28 files changed

+4337/−0 lines, 28 filesdep +basedep +cpu-features

Dependencies added: base, cpu-features

Files

CHANGELOG.md +17/−0
LICENSE +29/−0
README.md +15/−0
cbits/cpuid.c +14/−0
cbits/hwprobe.c +21/−0
cbits/sysctl.c +10/−0
cpu-features.cabal +75/−0
demo/Main.hs +151/−0
src/Hwcap.hsc +224/−0
src/Hwprobe.hsc +281/−0
src/System/CPUFeatures/Arm.hs +4/−0
src/System/CPUFeatures/Arm/Bool.hs +423/−0
src/System/CPUFeatures/Arm/Constraint.hs +65/−0
src/System/CPUFeatures/Arm/Constraint/Unsafe.hs +441/−0
src/System/CPUFeatures/Arm/TypeBool.hs +200/−0
src/System/CPUFeatures/RISCV.hs +4/−0
src/System/CPUFeatures/RISCV/Bool.hs +368/−0
src/System/CPUFeatures/RISCV/Constraint.hs +79/−0
src/System/CPUFeatures/RISCV/Constraint/Unsafe.hs +581/−0
src/System/CPUFeatures/RISCV/TypeBool.hs +312/−0
src/System/CPUFeatures/Util.hs +18/−0
src/System/CPUFeatures/X86.hs +4/−0
src/System/CPUFeatures/X86/Bool.hs +304/−0
src/System/CPUFeatures/X86/Constraint.hs +60/−0
src/System/CPUFeatures/X86/Constraint/Unsafe.hs +391/−0
src/System/CPUFeatures/X86/Cpuid.hs +62/−0
src/System/CPUFeatures/X86/TypeBool.hs +180/−0
test/Main.hs +4/−0

+ CHANGELOG.md view

@@ -0,0 +1,17 @@+# Revision history for cpu-features++## 0.1.0.0 -- 2025-04-26++Initial release.++Supported platforms:++* x86_64: via `cpuid`+    * Windows+    * macOS: uses `sysctlbyname` to detect AVX-512+    * Linux+* AArch64+    * macOS: via `sysctlbyname`+    * Linux: via `getauxval(AT_HWCAP/AT_HWCAP2)`+* RISC-V 64+    * Linux: via `getauxval(AT_HWCAP)` and hwprobe

+ LICENSE view

@@ -0,0 +1,29 @@+Copyright (c) 2024, ARATA Mizuki+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of the copyright holder nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,15 @@+# cpu-features for Haskell++This is a library to detect the features supported by the CPU running the Haskell program.++Supported platforms:++* i386/x86_64: via `cpuid`+    * Windows+    * macOS: uses `sysctlbyname` to detect AVX-512+    * Linux+* AArch64+    * macOS: via `sysctlbyname`+    * Linux: via `getauxval(AT_HWCAP/AT_HWCAP2)`+* RISC-V 64+    * Linux: via `getauxval(AT_HWCAP)` and hwprobe

+ cbits/cpuid.c view

@@ -0,0 +1,14 @@+#include <stdint.h>+#include <cpuid.h>+#include <immintrin.h>++void hs_cpu_features_cpuid(uint32_t eax, uint32_t ecx, uint32_t result[4])+{+    __cpuid_count(eax, ecx, result[0], result[1], result[2], result[3]);+}++__attribute__((target("xsave")))+uint64_t hs_cpu_features_xgetbv(uint32_t a)+{+    return _xgetbv(a);+}

+ cbits/hwprobe.c view

@@ -0,0 +1,21 @@+// For RISC-V Linux+#define _GNU_SOURCE+#include <stdint.h>+#include <unistd.h>+#include <asm/hwprobe.h>+#include <sched.h> // cpu_set_t+#include <sys/syscall.h> // SYS_riscv_hwprobe++uint64_t hs_cpu_features_hwprobe_ima_ext_0(void)+{+    struct riscv_hwprobe probe[1] = {+        {.key = RISCV_HWPROBE_KEY_IMA_EXT_0, .value = 0},+    };+    // long result = sys_riscv_hwprobe(probe, 1, 0, NULL, 0);+    long result = syscall(SYS_riscv_hwprobe, probe, (size_t)1, (size_t)0, (cpu_set_t *)NULL, 0u);+    if (result == 0) {+        return probe[0].value;+    } else {+        return 0;+    }+}

+ cbits/sysctl.c view

@@ -0,0 +1,10 @@+#include "HsFFI.h"+#include <sys/sysctl.h>++HsBool hs_cpu_features_sysctl(const char *name)+{+    int result = 0;+    size_t len = sizeof(result);+    int succ = sysctlbyname(name, &result, &len, NULL, 0);+    return succ == 0 && result != 0;+}

+ cpu-features.cabal view

@@ -0,0 +1,75 @@+cabal-version:      3.0+name:               cpu-features+version:            0.1.0.0+synopsis:           A library to detect CPU features+description:        This is a library to detect the features supported by the CPU running the Haskell program.+license:            BSD-3-Clause+license-file:       LICENSE+author:             ARATA Mizuki+maintainer:         minorinoki@gmail.com+copyright:          2025 ARATA Mizuki+category:           System+build-type:         Simple+extra-doc-files:    README.md CHANGELOG.md+-- extra-source-files:++common warnings+    ghc-options: -Wall -Wno-unticked-promoted-constructors++library+    import:           warnings+    exposed-modules:  System.CPUFeatures.X86+                      System.CPUFeatures.X86.Bool+                      System.CPUFeatures.X86.TypeBool+                      System.CPUFeatures.X86.Constraint+                      System.CPUFeatures.X86.Constraint.Unsafe+                      System.CPUFeatures.X86.Cpuid+                      System.CPUFeatures.Arm+                      System.CPUFeatures.Arm.Bool+                      System.CPUFeatures.Arm.TypeBool+                      System.CPUFeatures.Arm.Constraint+                      System.CPUFeatures.Arm.Constraint.Unsafe+                      System.CPUFeatures.RISCV+                      System.CPUFeatures.RISCV.Bool+                      System.CPUFeatures.RISCV.TypeBool+                      System.CPUFeatures.RISCV.Constraint+                      System.CPUFeatures.RISCV.Constraint.Unsafe+                      System.CPUFeatures.Util+    -- other-modules:+    -- other-extensions:+    if os(darwin)+      c-sources:      cbits/sysctl.c+    if os(linux) && (arch(aarch64) || arch(riscv64))+      other-modules:  Hwcap+    if arch(x86_64) || arch(i386)+      c-sources:      cbits/cpuid.c+    if os(linux) && arch(riscv64)+      other-modules:  Hwprobe+      c-sources:      cbits/hwprobe.c+    build-depends:    base >=4.16.0.0 && <4.22+    hs-source-dirs:   src+    default-language: GHC2021++executable cpu-features-demo+    import:           warnings+    main-is:          Main.hs+    -- other-modules:+    -- other-extensions:+    build-depends:+        base >=4.16.0.0 && <4.22,+        cpu-features++    hs-source-dirs:   demo+    default-language: GHC2021++test-suite cpu-features-test+    import:           warnings+    default-language: GHC2021+    -- other-modules:+    -- other-extensions:+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base >=4.16.0.0 && <4.22,+        cpu-features

+ demo/Main.hs view

@@ -0,0 +1,151 @@+{-# LANGUAGE GADTs #-}+module Main where++import System.CPUFeatures.X86 as X86+import System.CPUFeatures.X86.Cpuid as X86+import System.CPUFeatures.Arm as Arm+import System.CPUFeatures.RISCV as RISCV++main :: IO ()+main = do+  case X86.queryCpuid of+    Just Dict -> putStrLn $ "X86 Manufacturer: " ++ getManufacturerString+    Nothing -> putStrLn "Not X86"+  putStrLn $ "X86.AESNI = " ++ show X86.bAESNI+  putStrLn $ "X86.AMX_BF16 = " ++ show X86.bAMX_BF16+  putStrLn $ "X86.AMX_FP16 = " ++ show X86.bAMX_FP16+  putStrLn $ "X86.AMX_INT8 = " ++ show X86.bAMX_INT8+  putStrLn $ "X86.AMX_TILE = " ++ show X86.bAMX_TILE+  putStrLn $ "X86.AVX = " ++ show X86.bAVX+  putStrLn $ "X86.AVX_VNNI = " ++ show X86.bAVX_VNNI+  putStrLn $ "X86.AVX10_1 = " ++ show X86.bAVX10_1+  putStrLn $ "X86.AVX10_2 = " ++ show X86.bAVX10_2+  putStrLn $ "X86.AVX2 = " ++ show X86.bAVX2+  putStrLn $ "X86.AVX512_BF16 = " ++ show X86.bAVX512_BF16+  putStrLn $ "X86.AVX512_BITALG = " ++ show X86.bAVX512_BITALG+  putStrLn $ "X86.AVX512_FP16 = " ++ show X86.bAVX512_FP16+  putStrLn $ "X86.AVX512_IFMA = " ++ show X86.bAVX512_IFMA+  putStrLn $ "X86.AVX512_VBMI = " ++ show X86.bAVX512_VBMI+  putStrLn $ "X86.AVX512_VBMI2 = " ++ show X86.bAVX512_VBMI2+  putStrLn $ "X86.AVX512_VNNI = " ++ show X86.bAVX512_VNNI+  putStrLn $ "X86.AVX512_VPOPCNTDQ = " ++ show X86.bAVX512_VPOPCNTDQ+  putStrLn $ "X86.AVX512BW = " ++ show X86.bAVX512BW+  putStrLn $ "X86.AVX512CD = " ++ show X86.bAVX512CD+  putStrLn $ "X86.AVX512DQ = " ++ show X86.bAVX512DQ+  putStrLn $ "X86.AVX512F = " ++ show X86.bAVX512F+  putStrLn $ "X86.AVX512VL = " ++ show X86.bAVX512VL+  putStrLn $ "X86.BMI1 = " ++ show X86.bBMI1+  putStrLn $ "X86.BMI2 = " ++ show X86.bBMI2+  putStrLn $ "X86.F16C = " ++ show X86.bF16C+  putStrLn $ "X86.FMA = " ++ show X86.bFMA+  putStrLn $ "X86.GFNI = " ++ show X86.bGFNI+  putStrLn $ "X86.PCLMULQDQ = " ++ show X86.bPCLMULQDQ+  putStrLn $ "X86.POPCNT = " ++ show X86.bPOPCNT+  putStrLn $ "X86.RDRAND = " ++ show X86.bRDRAND+  putStrLn $ "X86.SHA = " ++ show X86.bSHA+  putStrLn $ "X86.SSE3 = " ++ show X86.bSSE3+  putStrLn $ "X86.SSE4_1 = " ++ show X86.bSSE4_1+  putStrLn $ "X86.SSE4_2 = " ++ show X86.bSSE4_2+  putStrLn $ "X86.SSSE3 = " ++ show X86.bSSSE3+  putStrLn $ "X86.VAES = " ++ show X86.bVAES+  putStrLn $ "X86.VPCLMULQDQ = " ++ show X86.bVPCLMULQDQ+  putStrLn $ "Arm.FEAT_AES = " ++ show Arm.bFEAT_AES+  putStrLn $ "Arm.FEAT_AFP = " ++ show Arm.bFEAT_AFP+  putStrLn $ "Arm.FEAT_BF16 = " ++ show Arm.bFEAT_BF16+  putStrLn $ "Arm.FEAT_BTI = " ++ show Arm.bFEAT_BTI+  putStrLn $ "Arm.FEAT_CSV2 = " ++ show Arm.bFEAT_CSV2+  putStrLn $ "Arm.FEAT_CSV3 = " ++ show Arm.bFEAT_CSV3+  putStrLn $ "Arm.FEAT_DIT = " ++ show Arm.bFEAT_DIT+  putStrLn $ "Arm.FEAT_DotProd = " ++ show Arm.bFEAT_DotProd+  putStrLn $ "Arm.FEAT_DPB = " ++ show Arm.bFEAT_DPB+  putStrLn $ "Arm.FEAT_DPB2 = " ++ show Arm.bFEAT_DPB2+  putStrLn $ "Arm.FEAT_ECV = " ++ show Arm.bFEAT_ECV+  putStrLn $ "Arm.FEAT_FCMA = " ++ show Arm.bFEAT_FCMA+  putStrLn $ "Arm.FEAT_FHM = " ++ show Arm.bFEAT_FHM+  putStrLn $ "Arm.FEAT_FlagM = " ++ show Arm.bFEAT_FlagM+  putStrLn $ "Arm.FEAT_FlagM2 = " ++ show Arm.bFEAT_FlagM2+  putStrLn $ "Arm.FEAT_FP16 = " ++ show Arm.bFEAT_FP16+  putStrLn $ "Arm.FEAT_FPAC = " ++ show Arm.bFEAT_FPAC+  putStrLn $ "Arm.FEAT_FRINTTS = " ++ show Arm.bFEAT_FRINTTS+  putStrLn $ "Arm.FEAT_I8MM = " ++ show Arm.bFEAT_I8MM+  putStrLn $ "Arm.FEAT_JSCVT = " ++ show Arm.bFEAT_JSCVT+  putStrLn $ "Arm.FEAT_LRCPC = " ++ show Arm.bFEAT_LRCPC+  putStrLn $ "Arm.FEAT_LRCPC2 = " ++ show Arm.bFEAT_LRCPC2+  putStrLn $ "Arm.FEAT_LSE = " ++ show Arm.bFEAT_LSE+  putStrLn $ "Arm.FEAT_LSE2 = " ++ show Arm.bFEAT_LSE2+  putStrLn $ "Arm.FEAT_PAuth = " ++ show Arm.bFEAT_PAuth+  putStrLn $ "Arm.FEAT_PAuth2 = " ++ show Arm.bFEAT_PAuth2+  putStrLn $ "Arm.FEAT_PMULL = " ++ show Arm.bFEAT_PMULL+  putStrLn $ "Arm.FEAT_RDM = " ++ show Arm.bFEAT_RDM+  putStrLn $ "Arm.FEAT_RPRES = " ++ show Arm.bFEAT_RPRES+  putStrLn $ "Arm.FEAT_SB = " ++ show Arm.bFEAT_SB+  putStrLn $ "Arm.FEAT_SHA1 = " ++ show Arm.bFEAT_SHA1+  putStrLn $ "Arm.FEAT_SHA256 = " ++ show Arm.bFEAT_SHA256+  putStrLn $ "Arm.FEAT_SHA3 = " ++ show Arm.bFEAT_SHA3+  putStrLn $ "Arm.FEAT_SHA512 = " ++ show Arm.bFEAT_SHA512+  putStrLn $ "Arm.FEAT_SME = " ++ show Arm.bFEAT_SME+  putStrLn $ "Arm.FEAT_SME_F64F64 = " ++ show Arm.bFEAT_SME_F64F64+  putStrLn $ "Arm.FEAT_SME_I16I64 = " ++ show Arm.bFEAT_SME_I16I64+  putStrLn $ "Arm.FEAT_SME2 = " ++ show Arm.bFEAT_SME2+  putStrLn $ "Arm.FEAT_SPECRES = " ++ show Arm.bFEAT_SPECRES+  putStrLn $ "Arm.FEAT_SSBS = " ++ show Arm.bFEAT_SSBS+  putStrLn $ "Arm.FEAT_SVE = " ++ show Arm.bFEAT_SVE+  putStrLn $ "Arm.FEAT_SVE2 = " ++ show Arm.bFEAT_SVE2+  putStrLn $ "Arm.FEAT_WFxT = " ++ show Arm.bFEAT_WFxT+  putStrLn $ "RISCV.C = " ++ show RISCV.bC+  putStrLn $ "RISCV.V = " ++ show RISCV.bV+  putStrLn $ "RISCV.Zba = " ++ show RISCV.bZba+  putStrLn $ "RISCV.Zbb = " ++ show RISCV.bZbb+  putStrLn $ "RISCV.Zbs = " ++ show RISCV.bZbs+  putStrLn $ "RISCV.Zicboz = " ++ show RISCV.bZicboz+  putStrLn $ "RISCV.Zbc = " ++ show RISCV.bZbc+  putStrLn $ "RISCV.Zbkb = " ++ show RISCV.bZbkb+  putStrLn $ "RISCV.Zbkc = " ++ show RISCV.bZbkc+  putStrLn $ "RISCV.Zbkx = " ++ show RISCV.bZbkx+  putStrLn $ "RISCV.Zknd = " ++ show RISCV.bZknd+  putStrLn $ "RISCV.Zkne = " ++ show RISCV.bZkne+  putStrLn $ "RISCV.Zknh = " ++ show RISCV.bZknh+  putStrLn $ "RISCV.Zksed = " ++ show RISCV.bZksed+  putStrLn $ "RISCV.Zksh = " ++ show RISCV.bZksh+  putStrLn $ "RISCV.Zkt = " ++ show RISCV.bZkt+  putStrLn $ "RISCV.Zvbb = " ++ show RISCV.bZvbb+  putStrLn $ "RISCV.Zvbc = " ++ show RISCV.bZvbc+  putStrLn $ "RISCV.Zvkb = " ++ show RISCV.bZvkb+  putStrLn $ "RISCV.Zvkg = " ++ show RISCV.bZvkg+  putStrLn $ "RISCV.Zvkned = " ++ show RISCV.bZvkned+  putStrLn $ "RISCV.Zvknha = " ++ show RISCV.bZvknha+  putStrLn $ "RISCV.Zvknhb = " ++ show RISCV.bZvknhb+  putStrLn $ "RISCV.Zvksed = " ++ show RISCV.bZvksed+  putStrLn $ "RISCV.Zvksh = " ++ show RISCV.bZvksh+  putStrLn $ "RISCV.Zvkt = " ++ show RISCV.bZvkt+  putStrLn $ "RISCV.Zfh = " ++ show RISCV.bZfh+  putStrLn $ "RISCV.Zfhmin = " ++ show RISCV.bZfhmin+  putStrLn $ "RISCV.Zihintntl = " ++ show RISCV.bZihintntl+  putStrLn $ "RISCV.Zvfh = " ++ show RISCV.bZvfh+  putStrLn $ "RISCV.Zvfhmin = " ++ show RISCV.bZvfhmin+  putStrLn $ "RISCV.Zfa = " ++ show RISCV.bZfa+  putStrLn $ "RISCV.Ztso = " ++ show RISCV.bZtso+  putStrLn $ "RISCV.Zacas = " ++ show RISCV.bZacas+  putStrLn $ "RISCV.Zicntr = " ++ show RISCV.bZicntr+  putStrLn $ "RISCV.Zicond = " ++ show RISCV.bZicond+  putStrLn $ "RISCV.Zihintpause = " ++ show RISCV.bZihintpause+  putStrLn $ "RISCV.Zihpm = " ++ show RISCV.bZihpm+  putStrLn $ "RISCV.Zve32x = " ++ show RISCV.bZve32x+  putStrLn $ "RISCV.Zve32f = " ++ show RISCV.bZve32f+  putStrLn $ "RISCV.Zve64x = " ++ show RISCV.bZve64x+  putStrLn $ "RISCV.Zve64f = " ++ show RISCV.bZve64f+  putStrLn $ "RISCV.Zve64d = " ++ show RISCV.bZve64d+  putStrLn $ "RISCV.Zimop = " ++ show RISCV.bZimop+  putStrLn $ "RISCV.Zca = " ++ show RISCV.bZca+  putStrLn $ "RISCV.Zcb = " ++ show RISCV.bZcb+  putStrLn $ "RISCV.Zcd = " ++ show RISCV.bZcd+  putStrLn $ "RISCV.Zcf = " ++ show RISCV.bZcf+  putStrLn $ "RISCV.Zcmop = " ++ show RISCV.bZcmop+  putStrLn $ "RISCV.Zawrs = " ++ show RISCV.bZawrs+  putStrLn $ "RISCV.Zaamo = " ++ show RISCV.bZaamo+  putStrLn $ "RISCV.Zalrsc = " ++ show RISCV.bZalrsc+  putStrLn $ "RISCV.Supm = " ++ show RISCV.bSupm+  putStrLn $ "RISCV.Zfbfmin = " ++ show RISCV.bZfbfmin+  putStrLn $ "RISCV.Zvfbfmin = " ++ show RISCV.bZvfbfmin+  putStrLn $ "RISCV.Zvfbfwma = " ++ show RISCV.bZvfbfwma+  putStrLn $ "RISCV.Zicbom = " ++ show RISCV.bZicbom

+ src/Hwcap.hsc view

@@ -0,0 +1,224 @@+{-# LANGUAGE CApiFFI #-}+module Hwcap where+import Foreign.C.Types+#if defined(riscv64_HOST_ARCH)+import Data.Char (ord)+import Data.Bits (bit)+#endif++#include <sys/auxv.h>++foreign import capi unsafe "sys/auxv.h getauxval" getauxval :: CULong -> CULong++{-# NOINLINE hwcap #-}+hwcap :: CULong+hwcap = getauxval #{const AT_HWCAP}++hwcap2 :: CULong+#if defined(AT_HWCAP2)+hwcap2 = getauxval #{const AT_HWCAP2}+{-# NOINLINE hwcap2 #-}+#else+hwcap2 = 0+#endif++#if defined(aarch64_HOST_ARCH)++hwcap_FP :: CULong+hwcap_FP = #{const HWCAP_FP}++hwcap_ASIMD :: CULong+hwcap_ASIMD = #{const HWCAP_ASIMD}++hwcap_EVTSTRM :: CULong+hwcap_EVTSTRM = #{const HWCAP_EVTSTRM}++hwcap_AES :: CULong+hwcap_AES = #{const HWCAP_AES}++hwcap_PMULL :: CULong+hwcap_PMULL = #{const HWCAP_PMULL}++hwcap_SHA1 :: CULong+hwcap_SHA1 = #{const HWCAP_SHA1}++hwcap_SHA2 :: CULong+hwcap_SHA2 = #{const HWCAP_SHA2}++hwcap_CRC32 :: CULong+hwcap_CRC32 = #{const HWCAP_CRC32}++hwcap_ATOMICS :: CULong+hwcap_ATOMICS = #{const HWCAP_ATOMICS}++hwcap_FPHP :: CULong+hwcap_FPHP = #{const HWCAP_FPHP}++hwcap_ASIMDHP :: CULong+hwcap_ASIMDHP = #{const HWCAP_ASIMDHP}++hwcap_CPUID :: CULong+hwcap_CPUID = #{const HWCAP_CPUID}++hwcap_ASIMDRDM :: CULong+hwcap_ASIMDRDM = #{const HWCAP_ASIMDRDM}++hwcap_JSCVT :: CULong+hwcap_JSCVT = #{const HWCAP_JSCVT}++hwcap_FCMA :: CULong+hwcap_FCMA = #{const HWCAP_FCMA}++hwcap_LRCPC :: CULong+hwcap_LRCPC = #{const HWCAP_LRCPC}++hwcap_DCPOP :: CULong+hwcap_DCPOP = #{const HWCAP_DCPOP}++hwcap_SHA3 :: CULong+hwcap_SHA3 = #{const HWCAP_SHA3}++hwcap_SM3 :: CULong+hwcap_SM3 = #{const HWCAP_SM3}++hwcap_SM4 :: CULong+hwcap_SM4 = #{const HWCAP_SM4}++hwcap_ASIMDDP :: CULong+hwcap_ASIMDDP = #{const HWCAP_ASIMDDP}++hwcap_SHA512 :: CULong+hwcap_SHA512 = #{const HWCAP_SHA512}++hwcap_SVE :: CULong+hwcap_SVE = #{const HWCAP_SVE}++hwcap_ASIMDFHM :: CULong+hwcap_ASIMDFHM = #{const HWCAP_ASIMDFHM}++hwcap_DIT :: CULong+hwcap_DIT = #{const HWCAP_DIT}++hwcap_USCAT :: CULong+hwcap_USCAT = #{const HWCAP_USCAT}++hwcap_ILRCPC :: CULong+hwcap_ILRCPC = #{const HWCAP_ILRCPC}++hwcap_FLAGM :: CULong+hwcap_FLAGM = #{const HWCAP_FLAGM}++hwcap_SSBS :: CULong+hwcap_SSBS = #{const HWCAP_SSBS}++hwcap_SB :: CULong+hwcap_SB = #{const HWCAP_SB}++hwcap_PACA :: CULong+hwcap_PACA = #{const HWCAP_PACA}++hwcap_PACG :: CULong+hwcap_PACG = #{const HWCAP_PACG}++hwcap2_DCPODP :: CULong+hwcap2_DCPODP = #{const HWCAP2_DCPODP}++hwcap2_SVE2 :: CULong+hwcap2_SVE2 = #{const HWCAP2_SVE2}++hwcap2_SVEAES :: CULong+hwcap2_SVEAES = #{const HWCAP2_SVEAES}++hwcap2_SVEPMULL :: CULong+hwcap2_SVEPMULL = #{const HWCAP2_SVEPMULL}++hwcap2_SVEBITPERM :: CULong+hwcap2_SVEBITPERM = #{const HWCAP2_SVEBITPERM}++hwcap2_SVESHA3 :: CULong+hwcap2_SVESHA3 = #{const HWCAP2_SVESHA3}++hwcap2_SVESM4 :: CULong+hwcap2_SVESM4 = #{const HWCAP2_SVESM4}++hwcap2_FLAGM2 :: CULong+hwcap2_FLAGM2 = #{const HWCAP2_FLAGM2}++hwcap2_FRINT :: CULong+hwcap2_FRINT = #{const HWCAP2_FRINT}++hwcap2_SVEI8MM :: CULong+hwcap2_SVEI8MM = #{const HWCAP2_SVEI8MM}++hwcap2_SVEF32MM :: CULong+hwcap2_SVEF32MM = #{const HWCAP2_SVEF32MM}++hwcap2_SVEF64MM :: CULong+hwcap2_SVEF64MM = #{const HWCAP2_SVEF64MM}++hwcap2_SVEBF16 :: CULong+hwcap2_SVEBF16 = #{const HWCAP2_SVEBF16}++hwcap2_I8MM :: CULong+hwcap2_I8MM = #{const HWCAP2_I8MM}++hwcap2_BF16 :: CULong+hwcap2_BF16 = #{const HWCAP2_BF16}++hwcap2_DGH :: CULong+hwcap2_DGH = #{const HWCAP2_DGH}++hwcap2_RNG :: CULong+hwcap2_RNG = #{const HWCAP2_RNG}++hwcap2_BTI :: CULong+hwcap2_BTI = #{const HWCAP2_BTI}++hwcap2_MTE :: CULong+hwcap2_MTE = #{const HWCAP2_MTE}++hwcap2_AFP :: CULong+hwcap2_AFP = #{const HWCAP2_AFP}++hwcap2_RPRES :: CULong+hwcap2_RPRES = #{const HWCAP2_RPRES}++hwcap2_SME :: CULong+hwcap2_SME = #{const HWCAP2_SME}++hwcap2_SME_F64F64 :: CULong+hwcap2_SME_F64F64 = #{const HWCAP2_SME_F64F64}++hwcap2_SME_I16I64 :: CULong+hwcap2_SME_I16I64 = #{const HWCAP2_SME_I16I64}++hwcap2_SME2 :: CULong+hwcap2_SME2 = #{const HWCAP2_SME2}++hwcap2_WFXT :: CULong+hwcap2_WFXT = #{const HWCAP2_WFXT}++#elif defined(riscv64_HOST_ARCH)++hwcap_I :: CULong+hwcap_I = bit (ord 'I' - ord 'A')++hwcap_M :: CULong+hwcap_M = bit (ord 'M' - ord 'A')++hwcap_A :: CULong+hwcap_A = bit (ord 'A' - ord 'A')++hwcap_F :: CULong+hwcap_F = bit (ord 'F' - ord 'A')++hwcap_D :: CULong+hwcap_D = bit (ord 'D' - ord 'A')++hwcap_C :: CULong+hwcap_C = bit (ord 'C' - ord 'A')++hwcap_V :: CULong+hwcap_V = bit (ord 'V' - ord 'A')++#endif

+ src/Hwprobe.hsc view

@@ -0,0 +1,281 @@+{-# LANGUAGE CApiFFI #-}+module Hwprobe where+import Data.Bits (bit)+import Data.Word (Word64)+import Foreign.C.Types+import System.IO.Unsafe (unsafePerformIO)++#include <asm/hwprobe.h>++foreign import ccall unsafe hs_cpu_features_hwprobe_ima_ext_0 :: IO Word64++hwprobe_ima_ext_0 :: Word64+hwprobe_ima_ext_0 = unsafePerformIO hs_cpu_features_hwprobe_ima_ext_0+{-# NOINLINE hwprobe_ima_ext_0 #-}++hwprobe_IMA_FD :: Word64+hwprobe_IMA_FD = #{const RISCV_HWPROBE_IMA_FD}++hwprobe_IMA_C :: Word64+hwprobe_IMA_C = #{const RISCV_HWPROBE_IMA_C}++hwprobe_IMA_V :: Word64+hwprobe_IMA_V = #{const RISCV_HWPROBE_IMA_V}++hwprobe_EXT_ZBA :: Word64+hwprobe_EXT_ZBA = #{const RISCV_HWPROBE_EXT_ZBA}++hwprobe_EXT_ZBB :: Word64+hwprobe_EXT_ZBB = #{const RISCV_HWPROBE_EXT_ZBB}++hwprobe_EXT_ZBS :: Word64+hwprobe_EXT_ZBS = #{const RISCV_HWPROBE_EXT_ZBS}++hwprobe_EXT_ZICBOZ :: Word64+hwprobe_EXT_ZICBOZ = #{const RISCV_HWPROBE_EXT_ZICBOZ}++hwprobe_EXT_ZBC :: Word64+hwprobe_EXT_ZBC = #{const RISCV_HWPROBE_EXT_ZBC}++hwprobe_EXT_ZBKB :: Word64+hwprobe_EXT_ZBKB = #{const RISCV_HWPROBE_EXT_ZBKB}++hwprobe_EXT_ZBKC :: Word64+hwprobe_EXT_ZBKC = #{const RISCV_HWPROBE_EXT_ZBKC}++hwprobe_EXT_ZBKX :: Word64+hwprobe_EXT_ZBKX = #{const RISCV_HWPROBE_EXT_ZBKX}++hwprobe_EXT_ZKND :: Word64+hwprobe_EXT_ZKND = #{const RISCV_HWPROBE_EXT_ZKND}++hwprobe_EXT_ZKNE :: Word64+hwprobe_EXT_ZKNE = #{const RISCV_HWPROBE_EXT_ZKNE}++hwprobe_EXT_ZKNH :: Word64+hwprobe_EXT_ZKNH = #{const RISCV_HWPROBE_EXT_ZKNH}++hwprobe_EXT_ZKSED :: Word64+hwprobe_EXT_ZKSED = #{const RISCV_HWPROBE_EXT_ZKSED}++hwprobe_EXT_ZKSH :: Word64+hwprobe_EXT_ZKSH = #{const RISCV_HWPROBE_EXT_ZKSH}++hwprobe_EXT_ZKT :: Word64+hwprobe_EXT_ZKT = #{const RISCV_HWPROBE_EXT_ZKT}++hwprobe_EXT_ZVBB :: Word64+hwprobe_EXT_ZVBB = #{const RISCV_HWPROBE_EXT_ZVBB}++hwprobe_EXT_ZVBC :: Word64+hwprobe_EXT_ZVBC = #{const RISCV_HWPROBE_EXT_ZVBC}++hwprobe_EXT_ZVKB :: Word64+hwprobe_EXT_ZVKB = #{const RISCV_HWPROBE_EXT_ZVKB}++hwprobe_EXT_ZVKG :: Word64+hwprobe_EXT_ZVKG = #{const RISCV_HWPROBE_EXT_ZVKG}++hwprobe_EXT_ZVKNED :: Word64+hwprobe_EXT_ZVKNED = #{const RISCV_HWPROBE_EXT_ZVKNED}++hwprobe_EXT_ZVKNHA :: Word64+hwprobe_EXT_ZVKNHA = #{const RISCV_HWPROBE_EXT_ZVKNHA}++hwprobe_EXT_ZVKNHB :: Word64+hwprobe_EXT_ZVKNHB = #{const RISCV_HWPROBE_EXT_ZVKNHB}++hwprobe_EXT_ZVKSED :: Word64+hwprobe_EXT_ZVKSED = #{const RISCV_HWPROBE_EXT_ZVKSED}++hwprobe_EXT_ZVKSH :: Word64+hwprobe_EXT_ZVKSH = #{const RISCV_HWPROBE_EXT_ZVKSH}++hwprobe_EXT_ZVKT :: Word64+hwprobe_EXT_ZVKT = #{const RISCV_HWPROBE_EXT_ZVKT}++hwprobe_EXT_ZFH :: Word64+hwprobe_EXT_ZFH = #{const RISCV_HWPROBE_EXT_ZFH}++hwprobe_EXT_ZFHMIN :: Word64+hwprobe_EXT_ZFHMIN = #{const RISCV_HWPROBE_EXT_ZFHMIN}++hwprobe_EXT_ZIHINTNTL :: Word64+hwprobe_EXT_ZIHINTNTL = #{const RISCV_HWPROBE_EXT_ZIHINTNTL}++hwprobe_EXT_ZVFH :: Word64+hwprobe_EXT_ZVFH = #{const RISCV_HWPROBE_EXT_ZVFH}++hwprobe_EXT_ZVFHMIN :: Word64+-- An older header defines RISCV_HWPROBE_EXT_ZVFHMIN as "(1 << 31)", not "(1ULL << 31)"+#if RISCV_HWPROBE_EXT_ZVFHMIN == (1ULL << 31)+hwprobe_EXT_ZVFHMIN = bit 31+#else+hwprobe_EXT_ZVFHMIN = #{const RISCV_HWPROBE_EXT_ZVFHMIN}+#endif++hwprobe_EXT_ZFA :: Word64+hwprobe_EXT_ZFA = #{const RISCV_HWPROBE_EXT_ZFA}++hwprobe_EXT_ZTSO :: Word64+hwprobe_EXT_ZTSO = #{const RISCV_HWPROBE_EXT_ZTSO}++hwprobe_EXT_ZACAS :: Word64+hwprobe_EXT_ZACAS = #{const RISCV_HWPROBE_EXT_ZACAS}++hwprobe_EXT_ZICNTR :: Word64+#ifdef RISCV_HWPROBE_EXT_ZICNTR+hwprobe_EXT_ZICNTR = #{const RISCV_HWPROBE_EXT_ZICNTR}+#else+hwprobe_EXT_ZICNTR = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZICOND :: Word64+hwprobe_EXT_ZICOND = #{const RISCV_HWPROBE_EXT_ZICOND}++hwprobe_EXT_ZIHINTPAUSE :: Word64+#ifdef RISCV_HWPROBE_EXT_ZHINTPAUSE+hwprobe_EXT_ZIHINTPAUSE = #{const RISCV_HWPROBE_EXT_ZIHINTPAUSE}+#else+hwprobe_EXT_ZIHINTPAUSE = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZIHPM :: Word64+#ifdef RISCV_HWPROBE_EXT_ZIHPM+hwprobe_EXT_ZIHPM = #{const RISCV_HWPROBE_EXT_ZIHPM}+#else+hwprobe_EXT_ZIHPM = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVE32X :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVE32X+hwprobe_EXT_ZVE32X = #{const RISCV_HWPROBE_EXT_ZVE32X}+#else+hwprobe_EXT_ZVE32X = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVE32F :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVE32F+hwprobe_EXT_ZVE32F = #{const RISCV_HWPROBE_EXT_ZVE32F}+#else+hwprobe_EXT_ZVE32F = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVE64X :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVE64X+hwprobe_EXT_ZVE64X = #{const RISCV_HWPROBE_EXT_ZVE64X}+#else+hwprobe_EXT_ZVE64X = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVE64F :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVE64F+hwprobe_EXT_ZVE64F = #{const RISCV_HWPROBE_EXT_ZVE64F}+#else+hwprobe_EXT_ZVE64F = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVE64D :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVE64D+hwprobe_EXT_ZVE64D = #{const RISCV_HWPROBE_EXT_ZVE64D}+#else+hwprobe_EXT_ZVE64D = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZIMOP :: Word64+#ifdef RISCV_HWPROBE_EXT_ZIMOP+hwprobe_EXT_ZIMOP = #{const RISCV_HWPROBE_EXT_ZIMOP}+#else+hwprobe_EXT_ZIMOP = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZCA :: Word64+#ifdef RISCV_HWPROBE_EXT_ZCA+hwprobe_EXT_ZCA = #{const RISCV_HWPROBE_EXT_ZCA}+#else+hwprobe_EXT_ZCA = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZCB :: Word64+#ifdef RISCV_HWPROBE_EXT_ZCB+hwprobe_EXT_ZCB = #{const RISCV_HWPROBE_EXT_ZCB}+#else+hwprobe_EXT_ZCB = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZCD :: Word64+#ifdef RISCV_HWPROBE_EXT_ZCD+hwprobe_EXT_ZCD = #{const RISCV_HWPROBE_EXT_ZCD}+#else+hwprobe_EXT_ZCD = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZCF :: Word64+#ifdef RISCV_HWPROBE_EXT_ZCF+hwprobe_EXT_ZCF = #{const RISCV_HWPROBE_EXT_ZCF}+#else+hwprobe_EXT_ZCF = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZCMOP :: Word64+#ifdef RISCV_HWPROBE_EXT_ZCMOP+hwprobe_EXT_ZCMOP = #{const RISCV_HWPROBE_EXT_ZCMOP}+#else+hwprobe_EXT_ZCMOP = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZAWRS :: Word64+#ifdef RISCV_HWPROBE_EXT_ZAWRS+hwprobe_EXT_ZAWRS = #{const RISCV_HWPROBE_EXT_ZAWRS}+#else+hwprobe_EXT_ZAWRS = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZAAMO :: Word64+#ifdef RISCV_HWPROBE_EXT_ZAAMO+hwprobe_EXT_ZAAMO = #{const RISCV_HWPROBE_EXT_ZAAMO}+#else+hwprobe_EXT_ZAAMO = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZALRSC :: Word64+#ifdef RISCV_HWPROBE_EXT_ZALRSC+hwprobe_EXT_ZALRSC = #{const RISCV_HWPROBE_EXT_ZALRSC}+#else+hwprobe_EXT_ZALRSC = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_SUPM :: Word64+#ifdef RISCV_HWPROBE_EXT_SUPM+hwprobe_EXT_SUPM = #{const RISCV_HWPROBE_EXT_SUPM}+#else+hwprobe_EXT_SUPM = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZFBFMIN :: Word64+#ifdef RISCV_HWPROBE_EXT_ZFBFMIN+hwprobe_EXT_ZFBFMIN = #{const RISCV_HWPROBE_EXT_ZFBFMIN}+#else+hwprobe_EXT_ZFBFMIN = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVFBFMIN :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVFBFMIN+hwprobe_EXT_ZVFBFMIN = #{const RISCV_HWPROBE_EXT_ZVFBFMIN}+#else+hwprobe_EXT_ZVFBFMIN = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZVFBFWMA :: Word64+#ifdef RISCV_HWPROBE_EXT_ZVFBFWMA+hwprobe_EXT_ZVFBFWMA = #{const RISCV_HWPROBE_EXT_ZVFBFWMA}+#else+hwprobe_EXT_ZVFBFWMA = 0 -- TODO: Should we embed the value?+#endif++hwprobe_EXT_ZICBOM :: Word64+#ifdef RISCV_HWPROBE_EXT_ZICBOM+hwprobe_EXT_ZICBOM = #{const RISCV_HWPROBE_EXT_ZICBOM}+#else+hwprobe_EXT_ZICBOM = 0 -- TODO: Should we embed the value?+#endif

+ src/System/CPUFeatures/Arm.hs view

@@ -0,0 +1,4 @@+module System.CPUFeatures.Arm+  (module System.CPUFeatures.Arm.Bool+  ) where+import System.CPUFeatures.Arm.Bool

+ src/System/CPUFeatures/Arm/Bool.hs view

@@ -0,0 +1,423 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+{- |+Description: Detect Arm features at runtime++This module provides the basic interface to detect CPU features.+The availability is indicated by a boolean variable (@b\<FEATRUE NAME\>@).+-}+module System.CPUFeatures.Arm.Bool+  (bFEAT_AES+  ,bFEAT_AFP+  ,bFEAT_BF16+  ,bFEAT_BTI+  ,bFEAT_CSV2+  ,bFEAT_CSV3+  ,bFEAT_DIT+  ,bFEAT_DotProd+  ,bFEAT_DPB+  ,bFEAT_DPB2+  ,bFEAT_ECV+  ,bFEAT_FCMA+  ,bFEAT_FHM+  ,bFEAT_FlagM+  ,bFEAT_FlagM2+  ,bFEAT_FP16+  ,bFEAT_FPAC+  ,bFEAT_FRINTTS+  ,bFEAT_I8MM+  ,bFEAT_JSCVT+  ,bFEAT_LRCPC+  ,bFEAT_LRCPC2+  ,bFEAT_LSE+  ,bFEAT_LSE2+  ,bFEAT_PAuth+  ,bFEAT_PAuth2+  ,bFEAT_PMULL+  ,bFEAT_RDM+  ,bFEAT_RPRES+  ,bFEAT_SB+  ,bFEAT_SHA1+  ,bFEAT_SHA256+  ,bFEAT_SHA3+  ,bFEAT_SHA512+  ,bFEAT_SME+  ,bFEAT_SME_F64F64+  ,bFEAT_SME_I16I64+  ,bFEAT_SME2+  ,bFEAT_SPECRES+  ,bFEAT_SSBS+  ,bFEAT_SVE+  ,bFEAT_SVE2+  ,bFEAT_WFxT+  ) where+#if defined(aarch64_HOST_ARCH) && defined(darwin_HOST_OS)+import GHC.Exts (Addr#)+#endif+#if defined(aarch64_HOST_ARCH) && defined(linux_HOST_OS)+import Hwcap+import Data.Bits+#endif++bFEAT_AES :: Bool+bFEAT_AFP :: Bool+bFEAT_BF16 :: Bool+bFEAT_BTI :: Bool+bFEAT_CSV2 :: Bool+bFEAT_CSV3 :: Bool+bFEAT_DIT :: Bool+bFEAT_DotProd :: Bool+bFEAT_DPB :: Bool+bFEAT_DPB2 :: Bool+bFEAT_ECV :: Bool+bFEAT_FCMA :: Bool+bFEAT_FHM :: Bool+bFEAT_FlagM :: Bool+bFEAT_FlagM2 :: Bool+bFEAT_FP16 :: Bool+bFEAT_FPAC :: Bool+bFEAT_FRINTTS :: Bool+bFEAT_I8MM :: Bool+bFEAT_JSCVT :: Bool+bFEAT_LRCPC :: Bool+bFEAT_LRCPC2 :: Bool+bFEAT_LSE :: Bool+bFEAT_LSE2 :: Bool+bFEAT_PAuth :: Bool+bFEAT_PAuth2 :: Bool+bFEAT_PMULL :: Bool+bFEAT_RDM :: Bool+bFEAT_RPRES :: Bool+bFEAT_SB :: Bool+bFEAT_SHA1 :: Bool+bFEAT_SHA256 :: Bool+bFEAT_SHA3 :: Bool+bFEAT_SHA512 :: Bool+bFEAT_SME :: Bool+bFEAT_SME_F64F64 :: Bool+bFEAT_SME_I16I64 :: Bool+bFEAT_SME2 :: Bool+bFEAT_SPECRES :: Bool+bFEAT_SSBS :: Bool+bFEAT_SVE :: Bool+bFEAT_SVE2 :: Bool+bFEAT_WFxT :: Bool++#if defined(aarch64_HOST_ARCH) && (defined(darwin_HOST_OS) || defined(linux_HOST_OS))++#if defined(darwin_HOST_OS)++foreign import ccall unsafe hs_cpu_features_sysctl :: Addr# -> Bool++{-# NOINLINE bFEAT_AES #-}+bFEAT_AES = hs_cpu_features_sysctl "hw.optional.arm.FEAT_AES"#++{-# NOINLINE bFEAT_AFP #-}+bFEAT_AFP = hs_cpu_features_sysctl "hw.optional.arm.FEAT_AFP"#++{-# NOINLINE bFEAT_BF16 #-}+bFEAT_BF16 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_BF16"#++{-# NOINLINE bFEAT_BTI #-}+bFEAT_BTI = hs_cpu_features_sysctl "hw.optional.arm.FEAT_BTI"#++{-# NOINLINE bFEAT_CSV2 #-}+bFEAT_CSV2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_CSV2"#++{-# NOINLINE bFEAT_CSV3 #-}+bFEAT_CSV3 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_CSV3"#++{-# NOINLINE bFEAT_DIT #-}+bFEAT_DIT = hs_cpu_features_sysctl "hw.optional.arm.FEAT_DIT"#++{-# NOINLINE bFEAT_DotProd #-}+bFEAT_DotProd = hs_cpu_features_sysctl "hw.optional.arm.FEAT_DotProd"#++{-# NOINLINE bFEAT_DPB #-}+bFEAT_DPB = hs_cpu_features_sysctl "hw.optional.arm.FEAT_DPB"#++{-# NOINLINE bFEAT_DPB2 #-}+bFEAT_DPB2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_DPB2"#++{-# NOINLINE bFEAT_ECV #-}+bFEAT_ECV = hs_cpu_features_sysctl "hw.optional.arm.FEAT_ECV"#++{-# NOINLINE bFEAT_FCMA #-}+bFEAT_FCMA = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FCMA"#++{-# NOINLINE bFEAT_FHM #-}+bFEAT_FHM = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FHM"#++{-# NOINLINE bFEAT_FlagM #-}+bFEAT_FlagM = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FlagM"#++{-# NOINLINE bFEAT_FlagM2 #-}+bFEAT_FlagM2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FlagM2"#++{-# NOINLINE bFEAT_FP16 #-}+bFEAT_FP16 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FP16"#++{-# NOINLINE bFEAT_FPAC #-}+bFEAT_FPAC = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FPAC"#++{-# NOINLINE bFEAT_FRINTTS #-}+bFEAT_FRINTTS = hs_cpu_features_sysctl "hw.optional.arm.FEAT_FRINTTS"#++{-# NOINLINE bFEAT_I8MM #-}+bFEAT_I8MM = hs_cpu_features_sysctl "hw.optional.arm.FEAT_I8MM"#++{-# NOINLINE bFEAT_JSCVT #-}+bFEAT_JSCVT = hs_cpu_features_sysctl "hw.optional.arm.FEAT_JSCVT"#++{-# NOINLINE bFEAT_LRCPC #-}+bFEAT_LRCPC = hs_cpu_features_sysctl "hw.optional.arm.FEAT_LRCPC"#++{-# NOINLINE bFEAT_LRCPC2 #-}+bFEAT_LRCPC2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_LRCPC2"#++{-# NOINLINE bFEAT_LSE #-}+bFEAT_LSE = hs_cpu_features_sysctl "hw.optional.arm.FEAT_LSE"#++{-# NOINLINE bFEAT_LSE2 #-}+bFEAT_LSE2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_LSE2"#++{-# NOINLINE bFEAT_PAuth #-}+bFEAT_PAuth = hs_cpu_features_sysctl "hw.optional.arm.FEAT_PAuth"#++{-# NOINLINE bFEAT_PAuth2 #-}+bFEAT_PAuth2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_PAuth2"#++{-# NOINLINE bFEAT_PMULL #-}+bFEAT_PMULL = hs_cpu_features_sysctl "hw.optional.arm.FEAT_PMULL"#++{-# NOINLINE bFEAT_RDM #-}+bFEAT_RDM = hs_cpu_features_sysctl "hw.optional.arm.FEAT_RDM"#++{-# NOINLINE bFEAT_RPRES #-}+bFEAT_RPRES = hs_cpu_features_sysctl "hw.optional.arm.FEAT_RPRES"#++{-# NOINLINE bFEAT_SB #-}+bFEAT_SB = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SB"#++{-# NOINLINE bFEAT_SHA1 #-}+bFEAT_SHA1 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SHA1"#++{-# NOINLINE bFEAT_SHA256 #-}+bFEAT_SHA256 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SHA256"#++{-# NOINLINE bFEAT_SHA3 #-}+bFEAT_SHA3 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SHA3"#++{-# NOINLINE bFEAT_SHA512 #-}+bFEAT_SHA512 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SHA512"#++{-# NOINLINE bFEAT_SME #-}+bFEAT_SME = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SME"#++{-# NOINLINE bFEAT_SME_F64F64 #-}+bFEAT_SME_F64F64 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SME_F64F64"#++{-# NOINLINE bFEAT_SME_I16I64 #-}+bFEAT_SME_I16I64 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SME_I16I64"#++{-# NOINLINE bFEAT_SME2 #-}+bFEAT_SME2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SME2"#++{-# NOINLINE bFEAT_SPECRES #-}+bFEAT_SPECRES = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SPECRES"#++{-# NOINLINE bFEAT_SSBS #-}+bFEAT_SSBS = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SSBS"#++{-# NOINLINE bFEAT_SVE #-}+bFEAT_SVE = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SVE"#++{-# NOINLINE bFEAT_SVE2 #-}+bFEAT_SVE2 = hs_cpu_features_sysctl "hw.optional.arm.FEAT_SVE2"#++{-# NOINLINE bFEAT_WFxT #-}+bFEAT_WFxT = hs_cpu_features_sysctl "hw.optional.arm.FEAT_WFxT"#++#elif defined(linux_HOST_OS)++bFEAT_AES = hwcap .&. hwcap_AES /= 0+bFEAT_AFP = hwcap2 .&. hwcap2_AFP /= 0+bFEAT_BF16 = hwcap2 .&. hwcap2_BF16 /= 0+bFEAT_BTI = hwcap2 .&. hwcap2_BTI /= 0+bFEAT_CSV2 = False+bFEAT_CSV3 = False+bFEAT_DIT = hwcap .&. hwcap_DIT /= 0+bFEAT_DotProd = hwcap .&. hwcap_ASIMDDP /= 0+bFEAT_DPB = hwcap .&. hwcap_DCPOP /= 0+bFEAT_DPB2 = hwcap2 .&. hwcap2_DCPODP /= 0+bFEAT_ECV = False+bFEAT_FCMA = hwcap .&. hwcap_FCMA /= 0+bFEAT_FHM = hwcap .&. hwcap_ASIMDFHM /= 0+bFEAT_FlagM = hwcap .&. hwcap_FLAGM /= 0+bFEAT_FlagM2 = hwcap2 .&. hwcap2_FLAGM2 /= 0+bFEAT_FP16 = hwcap .&. hwcap_FPHP /= 0 -- hwcap_ASIMDHP?+bFEAT_FPAC = False+bFEAT_FRINTTS = hwcap2 .&. hwcap2_FRINT /= 0+bFEAT_I8MM = hwcap2 .&. hwcap2_I8MM /= 0+bFEAT_JSCVT = hwcap .&. hwcap_JSCVT /= 0+bFEAT_LRCPC = hwcap .&. hwcap_LRCPC /= 0+bFEAT_LRCPC2 = hwcap .&. hwcap_ILRCPC /= 0+bFEAT_LSE = hwcap .&. hwcap_ATOMICS /= 0+bFEAT_LSE2 = hwcap .&. hwcap_USCAT /= 0+bFEAT_PAuth = hwcap .&. hwcap_PACA /= 0+bFEAT_PAuth2 = False+bFEAT_PMULL = hwcap .&. hwcap_PMULL /= 0+bFEAT_RDM = hwcap .&. hwcap_ASIMDRDM /= 0+bFEAT_RPRES = hwcap2 .&. hwcap2_RPRES /= 0+bFEAT_SB = hwcap .&. hwcap_SB /= 0+bFEAT_SHA1 = hwcap .&. hwcap_SHA1 /= 0+bFEAT_SHA256 = hwcap .&. hwcap_SHA2 /= 0+bFEAT_SHA3 = hwcap .&. hwcap_SHA3 /= 0+bFEAT_SHA512 = hwcap .&. hwcap_SHA512 /= 0+bFEAT_SME = hwcap2 .&. hwcap2_SME /= 0+bFEAT_SME_F64F64 = hwcap2 .&. hwcap2_SME_F64F64 /= 0+bFEAT_SME_I16I64 = hwcap2 .&. hwcap2_SME_I16I64 /= 0+bFEAT_SME2 = hwcap2 .&. hwcap2_SME2 /= 0+bFEAT_SPECRES = False+bFEAT_SSBS = hwcap .&. hwcap_SSBS /= 0 -- FEAT_SSB2?+bFEAT_SVE = hwcap .&. hwcap_SVE /= 0+bFEAT_SVE2 = hwcap2 .&. hwcap2_SVE2 /= 0+bFEAT_WFxT = hwcap2 .&. hwcap2_WFXT /= 0++#else+#error bug+#endif++#else++{-# INLINE bFEAT_AES #-}+bFEAT_AES = False++{-# INLINE bFEAT_AFP #-}+bFEAT_AFP = False++{-# INLINE bFEAT_BF16 #-}+bFEAT_BF16 = False++{-# INLINE bFEAT_BTI #-}+bFEAT_BTI = False++{-# INLINE bFEAT_CSV2 #-}+bFEAT_CSV2 = False++{-# INLINE bFEAT_CSV3 #-}+bFEAT_CSV3 = False++{-# INLINE bFEAT_DIT #-}+bFEAT_DIT = False++{-# INLINE bFEAT_DotProd #-}+bFEAT_DotProd = False++{-# INLINE bFEAT_DPB #-}+bFEAT_DPB = False++{-# INLINE bFEAT_DPB2 #-}+bFEAT_DPB2 = False++{-# INLINE bFEAT_ECV #-}+bFEAT_ECV = False++{-# INLINE bFEAT_FCMA #-}+bFEAT_FCMA = False++{-# INLINE bFEAT_FHM #-}+bFEAT_FHM = False++{-# INLINE bFEAT_FlagM #-}+bFEAT_FlagM = False++{-# INLINE bFEAT_FlagM2 #-}+bFEAT_FlagM2 = False++{-# INLINE bFEAT_FP16 #-}+bFEAT_FP16 = False++{-# INLINE bFEAT_FPAC #-}+bFEAT_FPAC = False++{-# INLINE bFEAT_FRINTTS #-}+bFEAT_FRINTTS = False++{-# INLINE bFEAT_I8MM #-}+bFEAT_I8MM = False++{-# INLINE bFEAT_JSCVT #-}+bFEAT_JSCVT = False++{-# INLINE bFEAT_LRCPC #-}+bFEAT_LRCPC = False++{-# INLINE bFEAT_LRCPC2 #-}+bFEAT_LRCPC2 = False++{-# INLINE bFEAT_LSE #-}+bFEAT_LSE = False++{-# INLINE bFEAT_LSE2 #-}+bFEAT_LSE2 = False++{-# INLINE bFEAT_PAuth #-}+bFEAT_PAuth = False++{-# INLINE bFEAT_PAuth2 #-}+bFEAT_PAuth2 = False++{-# INLINE bFEAT_PMULL #-}+bFEAT_PMULL = False++{-# INLINE bFEAT_RDM #-}+bFEAT_RDM = False++{-# INLINE bFEAT_RPRES #-}+bFEAT_RPRES = False++{-# INLINE bFEAT_SB #-}+bFEAT_SB = False++{-# INLINE bFEAT_SHA1 #-}+bFEAT_SHA1 = False++{-# INLINE bFEAT_SHA256 #-}+bFEAT_SHA256 = False++{-# INLINE bFEAT_SHA3 #-}+bFEAT_SHA3 = False++{-# INLINE bFEAT_SHA512 #-}+bFEAT_SHA512 = False++{-# INLINE bFEAT_SME #-}+bFEAT_SME = False++{-# INLINE bFEAT_SME_F64F64 #-}+bFEAT_SME_F64F64 = False++{-# INLINE bFEAT_SME_I16I64 #-}+bFEAT_SME_I16I64 = False++{-# INLINE bFEAT_SME2 #-}+bFEAT_SME2 = False++{-# INLINE bFEAT_SPECRES #-}+bFEAT_SPECRES = False++{-# INLINE bFEAT_SSBS #-}+bFEAT_SSBS = False++{-# INLINE bFEAT_SVE #-}+bFEAT_SVE = False++{-# INLINE bFEAT_SVE2 #-}+bFEAT_SVE2 = False++{-# INLINE bFEAT_WFxT #-}+bFEAT_WFxT = False++#endif

+ src/System/CPUFeatures/Arm/Constraint.hs view

@@ -0,0 +1,65 @@+{- |+Description: Arm features as nullary constraints++This module provides the constraint interface to detect CPU features.+You can mark your function with @Has\<FEATURE NAME\> =>@ to indicate that+it requires a specific CPU feature.+You can detect the availability and get the constraint @Has\<FEATURE NAME\>@+by pattern-matching on the variable @query\<FEATURE NAME\>@.++Example:++> -- This function requires FEAT_PMULL+> someFunction :: HasFEAT_PMULL => ...+>+> case queryFEAT_PMULL of+>   Just Dict -> {- In this branch, HasFEAT_PMULL is available -} someFunction+>   Nothing -> {- In this branch, HasFEAT_PMULL is not available -} error "FEAT_PMULL not available"+-}+module System.CPUFeatures.Arm.Constraint+  (HasFEAT_AES, queryFEAT_AES+  ,HasFEAT_AFP, queryFEAT_AFP+  ,HasFEAT_BF16, queryFEAT_BF16+  ,HasFEAT_BTI, queryFEAT_BTI+  ,HasFEAT_CSV2, queryFEAT_CSV2+  ,HasFEAT_CSV3, queryFEAT_CSV3+  ,HasFEAT_DIT, queryFEAT_DIT+  ,HasFEAT_DotProd, queryFEAT_DotProd+  ,HasFEAT_DPB, queryFEAT_DPB+  ,HasFEAT_DPB2, queryFEAT_DPB2+  ,HasFEAT_ECV, queryFEAT_ECV+  ,HasFEAT_FCMA, queryFEAT_FCMA+  ,HasFEAT_FHM, queryFEAT_FHM+  ,HasFEAT_FlagM, queryFEAT_FlagM+  ,HasFEAT_FlagM2, queryFEAT_FlagM2+  ,HasFEAT_FP16, queryFEAT_FP16+  ,HasFEAT_FPAC, queryFEAT_FPAC+  ,HasFEAT_FRINTTS, queryFEAT_FRINTTS+  ,HasFEAT_I8MM, queryFEAT_I8MM+  ,HasFEAT_JSCVT, queryFEAT_JSCVT+  ,HasFEAT_LRCPC, queryFEAT_LRCPC+  ,HasFEAT_LRCPC2, queryFEAT_LRCPC2+  ,HasFEAT_LSE, queryFEAT_LSE+  ,HasFEAT_LSE2, queryFEAT_LSE2+  ,HasFEAT_PAuth, queryFEAT_PAuth+  ,HasFEAT_PAuth2, queryFEAT_PAuth2+  ,HasFEAT_PMULL, queryFEAT_PMULL+  ,HasFEAT_RDM, queryFEAT_RDM+  ,HasFEAT_RPRES, queryFEAT_RPRES+  ,HasFEAT_SB, queryFEAT_SB+  ,HasFEAT_SHA1, queryFEAT_SHA1+  ,HasFEAT_SHA256, queryFEAT_SHA256+  ,HasFEAT_SHA3, queryFEAT_SHA3+  ,HasFEAT_SHA512, queryFEAT_SHA512+  ,HasFEAT_SME, queryFEAT_SME+  ,HasFEAT_SME_F64F64, queryFEAT_SME_F64F64+  ,HasFEAT_SME_I16I64, queryFEAT_SME_I16I64+  ,HasFEAT_SME2, queryFEAT_SME2+  ,HasFEAT_SPECRES, queryFEAT_SPECRES+  ,HasFEAT_SSBS, queryFEAT_SSBS+  ,HasFEAT_SVE, queryFEAT_SVE+  ,HasFEAT_SVE2, queryFEAT_SVE2+  ,HasFEAT_WFxT, queryFEAT_WFxT+  ,Dict(Dict)+  ) where+import System.CPUFeatures.Arm.Constraint.Unsafe

+ src/System/CPUFeatures/Arm/Constraint/Unsafe.hs view

@@ -0,0 +1,441 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module System.CPUFeatures.Arm.Constraint.Unsafe+  ( module System.CPUFeatures.Arm.Constraint.Unsafe+  , Dict (Dict)+  ) where+import Data.Type.Equality ((:~:)(Refl))+import System.CPUFeatures.Util+import System.CPUFeatures.Arm.TypeBool+import Unsafe.Coerce (unsafeCoerce)++class FEAT_AES ~ True => HasFEAT_AES+instance FEAT_AES ~ True => HasFEAT_AES++class FEAT_AFP ~ True => HasFEAT_AFP+instance FEAT_AFP ~ True => HasFEAT_AFP++class FEAT_BF16 ~ True => HasFEAT_BF16+instance FEAT_BF16 ~ True => HasFEAT_BF16++class FEAT_BTI ~ True => HasFEAT_BTI+instance FEAT_BTI ~ True => HasFEAT_BTI++class FEAT_CSV2 ~ True => HasFEAT_CSV2+instance FEAT_CSV2 ~ True => HasFEAT_CSV2++class FEAT_CSV3 ~ True => HasFEAT_CSV3+instance FEAT_CSV3 ~ True => HasFEAT_CSV3++class FEAT_DIT ~ True => HasFEAT_DIT+instance FEAT_DIT ~ True => HasFEAT_DIT++class FEAT_DotProd ~ True => HasFEAT_DotProd+instance FEAT_DotProd ~ True => HasFEAT_DotProd++class FEAT_DPB ~ True => HasFEAT_DPB+instance FEAT_DPB ~ True => HasFEAT_DPB++class FEAT_DPB2 ~ True => HasFEAT_DPB2+instance FEAT_DPB2 ~ True => HasFEAT_DPB2++class FEAT_ECV ~ True => HasFEAT_ECV+instance FEAT_ECV ~ True => HasFEAT_ECV++class FEAT_FCMA ~ True => HasFEAT_FCMA+instance FEAT_FCMA ~ True => HasFEAT_FCMA++class FEAT_FHM ~ True => HasFEAT_FHM+instance FEAT_FHM ~ True => HasFEAT_FHM++class FEAT_FlagM ~ True => HasFEAT_FlagM+instance FEAT_FlagM ~ True => HasFEAT_FlagM++class FEAT_FlagM2 ~ True => HasFEAT_FlagM2+instance FEAT_FlagM2 ~ True => HasFEAT_FlagM2++class FEAT_FP16 ~ True => HasFEAT_FP16+instance FEAT_FP16 ~ True => HasFEAT_FP16++class FEAT_FPAC ~ True => HasFEAT_FPAC+instance FEAT_FPAC ~ True => HasFEAT_FPAC++class FEAT_FRINTTS ~ True => HasFEAT_FRINTTS+instance FEAT_FRINTTS ~ True => HasFEAT_FRINTTS++class FEAT_I8MM ~ True => HasFEAT_I8MM+instance FEAT_I8MM ~ True => HasFEAT_I8MM++class FEAT_JSCVT ~ True => HasFEAT_JSCVT+instance FEAT_JSCVT ~ True => HasFEAT_JSCVT++class FEAT_LRCPC ~ True => HasFEAT_LRCPC+instance FEAT_LRCPC ~ True => HasFEAT_LRCPC++class FEAT_LRCPC2 ~ True => HasFEAT_LRCPC2+instance FEAT_LRCPC2 ~ True => HasFEAT_LRCPC2++class FEAT_LSE ~ True => HasFEAT_LSE+instance FEAT_LSE ~ True => HasFEAT_LSE++class FEAT_LSE2 ~ True => HasFEAT_LSE2+instance FEAT_LSE2 ~ True => HasFEAT_LSE2++class FEAT_PAuth ~ True => HasFEAT_PAuth+instance FEAT_PAuth ~ True => HasFEAT_PAuth++class FEAT_PAuth2 ~ True => HasFEAT_PAuth2+instance FEAT_PAuth2 ~ True => HasFEAT_PAuth2++class FEAT_PMULL ~ True => HasFEAT_PMULL+instance FEAT_PMULL ~ True => HasFEAT_PMULL++class FEAT_RDM ~ True => HasFEAT_RDM+instance FEAT_RDM ~ True => HasFEAT_RDM++class FEAT_RPRES ~ True => HasFEAT_RPRES+instance FEAT_RPRES ~ True => HasFEAT_RPRES++class FEAT_SB ~ True => HasFEAT_SB+instance FEAT_SB ~ True => HasFEAT_SB++class FEAT_SHA1 ~ True => HasFEAT_SHA1+instance FEAT_SHA1 ~ True => HasFEAT_SHA1++class FEAT_SHA256 ~ True => HasFEAT_SHA256+instance FEAT_SHA256 ~ True => HasFEAT_SHA256++class FEAT_SHA3 ~ True => HasFEAT_SHA3+instance FEAT_SHA3 ~ True => HasFEAT_SHA3++class FEAT_SHA512 ~ True => HasFEAT_SHA512+instance FEAT_SHA512 ~ True => HasFEAT_SHA512++class FEAT_SME ~ True => HasFEAT_SME+instance FEAT_SME ~ True => HasFEAT_SME++class FEAT_SME_F64F64 ~ True => HasFEAT_SME_F64F64+instance FEAT_SME_F64F64 ~ True => HasFEAT_SME_F64F64++class FEAT_SME_I16I64 ~ True => HasFEAT_SME_I16I64+instance FEAT_SME_I16I64 ~ True => HasFEAT_SME_I16I64++class FEAT_SME2 ~ True => HasFEAT_SME2+instance FEAT_SME2 ~ True => HasFEAT_SME2++class FEAT_SPECRES ~ True => HasFEAT_SPECRES+instance FEAT_SPECRES ~ True => HasFEAT_SPECRES++class FEAT_SSBS ~ True => HasFEAT_SSBS+instance FEAT_SSBS ~ True => HasFEAT_SSBS++class FEAT_SVE ~ True => HasFEAT_SVE+instance FEAT_SVE ~ True => HasFEAT_SVE++class FEAT_SVE2 ~ True => HasFEAT_SVE2+instance FEAT_SVE2 ~ True => HasFEAT_SVE2++class FEAT_WFxT ~ True => HasFEAT_WFxT+instance FEAT_WFxT ~ True => HasFEAT_WFxT++unsafeAssumeFEAT_AES :: (HasFEAT_AES => a) -> a+unsafeAssumeFEAT_AES k = case unsafeCoerce Refl :: FEAT_AES :~: True of Refl -> k++queryFEAT_AES :: Maybe (Dict HasFEAT_AES)+queryFEAT_AES = case sFEAT_AES of STrue -> unsafeAssumeFEAT_AES (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_AES #-}++unsafeAssumeFEAT_AFP :: (HasFEAT_AFP => a) -> a+unsafeAssumeFEAT_AFP k = case unsafeCoerce Refl :: FEAT_AFP :~: True of Refl -> k++queryFEAT_AFP :: Maybe (Dict HasFEAT_AFP)+queryFEAT_AFP = case sFEAT_AFP of STrue -> unsafeAssumeFEAT_AFP (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_AFP #-}++unsafeAssumeFEAT_BF16 :: (HasFEAT_BF16 => a) -> a+unsafeAssumeFEAT_BF16 k = case unsafeCoerce Refl :: FEAT_BF16 :~: True of Refl -> k++queryFEAT_BF16 :: Maybe (Dict HasFEAT_BF16)+queryFEAT_BF16 = case sFEAT_BF16 of STrue -> unsafeAssumeFEAT_BF16 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_BF16 #-}++unsafeAssumeFEAT_BTI :: (HasFEAT_BTI => a) -> a+unsafeAssumeFEAT_BTI k = case unsafeCoerce Refl :: FEAT_BTI :~: True of Refl -> k++queryFEAT_BTI :: Maybe (Dict HasFEAT_BTI)+queryFEAT_BTI = case sFEAT_BTI of STrue -> unsafeAssumeFEAT_BTI (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_BTI #-}++unsafeAssumeFEAT_CSV2 :: (HasFEAT_CSV2 => a) -> a+unsafeAssumeFEAT_CSV2 k = case unsafeCoerce Refl :: FEAT_CSV2 :~: True of Refl -> k++queryFEAT_CSV2 :: Maybe (Dict HasFEAT_CSV2)+queryFEAT_CSV2 = case sFEAT_CSV2 of STrue -> unsafeAssumeFEAT_CSV2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_CSV2 #-}++unsafeAssumeFEAT_CSV3 :: (HasFEAT_CSV3 => a) -> a+unsafeAssumeFEAT_CSV3 k = case unsafeCoerce Refl :: FEAT_CSV3 :~: True of Refl -> k++queryFEAT_CSV3 :: Maybe (Dict HasFEAT_CSV3)+queryFEAT_CSV3 = case sFEAT_CSV3 of STrue -> unsafeAssumeFEAT_CSV3 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_CSV3 #-}++unsafeAssumeFEAT_DIT :: (HasFEAT_DIT => a) -> a+unsafeAssumeFEAT_DIT k = case unsafeCoerce Refl :: FEAT_DIT :~: True of Refl -> k++queryFEAT_DIT :: Maybe (Dict HasFEAT_DIT)+queryFEAT_DIT = case sFEAT_DIT of STrue -> unsafeAssumeFEAT_DIT (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_DIT #-}++unsafeAssumeFEAT_DotProd :: (HasFEAT_DotProd => a) -> a+unsafeAssumeFEAT_DotProd k = case unsafeCoerce Refl :: FEAT_DotProd :~: True of Refl -> k++queryFEAT_DotProd :: Maybe (Dict HasFEAT_DotProd)+queryFEAT_DotProd = case sFEAT_DotProd of STrue -> unsafeAssumeFEAT_DotProd (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_DotProd #-}++unsafeAssumeFEAT_DPB :: (HasFEAT_DPB => a) -> a+unsafeAssumeFEAT_DPB k = case unsafeCoerce Refl :: FEAT_DPB :~: True of Refl -> k++queryFEAT_DPB :: Maybe (Dict HasFEAT_DPB)+queryFEAT_DPB = case sFEAT_DPB of STrue -> unsafeAssumeFEAT_DPB (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_DPB #-}++unsafeAssumeFEAT_DPB2 :: (HasFEAT_DPB2 => a) -> a+unsafeAssumeFEAT_DPB2 k = case unsafeCoerce Refl :: FEAT_DPB2 :~: True of Refl -> k++queryFEAT_DPB2 :: Maybe (Dict HasFEAT_DPB2)+queryFEAT_DPB2 = case sFEAT_DPB2 of STrue -> unsafeAssumeFEAT_DPB2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_DPB2 #-}++unsafeAssumeFEAT_ECV :: (HasFEAT_ECV => a) -> a+unsafeAssumeFEAT_ECV k = case unsafeCoerce Refl :: FEAT_ECV :~: True of Refl -> k++queryFEAT_ECV :: Maybe (Dict HasFEAT_ECV)+queryFEAT_ECV = case sFEAT_ECV of STrue -> unsafeAssumeFEAT_ECV (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_ECV #-}++unsafeAssumeFEAT_FCMA :: (HasFEAT_FCMA => a) -> a+unsafeAssumeFEAT_FCMA k = case unsafeCoerce Refl :: FEAT_FCMA :~: True of Refl -> k++queryFEAT_FCMA :: Maybe (Dict HasFEAT_FCMA)+queryFEAT_FCMA = case sFEAT_FCMA of STrue -> unsafeAssumeFEAT_FCMA (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FCMA #-}++unsafeAssumeFEAT_FHM :: (HasFEAT_FHM => a) -> a+unsafeAssumeFEAT_FHM k = case unsafeCoerce Refl :: FEAT_FHM :~: True of Refl -> k++queryFEAT_FHM :: Maybe (Dict HasFEAT_FHM)+queryFEAT_FHM = case sFEAT_FHM of STrue -> unsafeAssumeFEAT_FHM (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FHM #-}++unsafeAssumeFEAT_FlagM :: (HasFEAT_FlagM => a) -> a+unsafeAssumeFEAT_FlagM k = case unsafeCoerce Refl :: FEAT_FlagM :~: True of Refl -> k++queryFEAT_FlagM :: Maybe (Dict HasFEAT_FlagM)+queryFEAT_FlagM = case sFEAT_FlagM of STrue -> unsafeAssumeFEAT_FlagM (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FlagM #-}++unsafeAssumeFEAT_FlagM2 :: (HasFEAT_FlagM2 => a) -> a+unsafeAssumeFEAT_FlagM2 k = case unsafeCoerce Refl :: FEAT_FlagM2 :~: True of Refl -> k++queryFEAT_FlagM2 :: Maybe (Dict HasFEAT_FlagM2)+queryFEAT_FlagM2 = case sFEAT_FlagM2 of STrue -> unsafeAssumeFEAT_FlagM2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FlagM2 #-}++unsafeAssumeFEAT_FP16 :: (HasFEAT_FP16 => a) -> a+unsafeAssumeFEAT_FP16 k = case unsafeCoerce Refl :: FEAT_FP16 :~: True of Refl -> k++queryFEAT_FP16 :: Maybe (Dict HasFEAT_FP16)+queryFEAT_FP16 = case sFEAT_FP16 of STrue -> unsafeAssumeFEAT_FP16 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FP16 #-}++unsafeAssumeFEAT_FPAC :: (HasFEAT_FPAC => a) -> a+unsafeAssumeFEAT_FPAC k = case unsafeCoerce Refl :: FEAT_FPAC :~: True of Refl -> k++queryFEAT_FPAC :: Maybe (Dict HasFEAT_FPAC)+queryFEAT_FPAC = case sFEAT_FPAC of STrue -> unsafeAssumeFEAT_FPAC (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FPAC #-}++unsafeAssumeFEAT_FRINTTS :: (HasFEAT_FRINTTS => a) -> a+unsafeAssumeFEAT_FRINTTS k = case unsafeCoerce Refl :: FEAT_FRINTTS :~: True of Refl -> k++queryFEAT_FRINTTS :: Maybe (Dict HasFEAT_FRINTTS)+queryFEAT_FRINTTS = case sFEAT_FRINTTS of STrue -> unsafeAssumeFEAT_FRINTTS (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_FRINTTS #-}++unsafeAssumeFEAT_I8MM :: (HasFEAT_I8MM => a) -> a+unsafeAssumeFEAT_I8MM k = case unsafeCoerce Refl :: FEAT_I8MM :~: True of Refl -> k++queryFEAT_I8MM :: Maybe (Dict HasFEAT_I8MM)+queryFEAT_I8MM = case sFEAT_I8MM of STrue -> unsafeAssumeFEAT_I8MM (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_I8MM #-}++unsafeAssumeFEAT_JSCVT :: (HasFEAT_JSCVT => a) -> a+unsafeAssumeFEAT_JSCVT k = case unsafeCoerce Refl :: FEAT_JSCVT :~: True of Refl -> k++queryFEAT_JSCVT :: Maybe (Dict HasFEAT_JSCVT)+queryFEAT_JSCVT = case sFEAT_JSCVT of STrue -> unsafeAssumeFEAT_JSCVT (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_JSCVT #-}++unsafeAssumeFEAT_LRCPC :: (HasFEAT_LRCPC => a) -> a+unsafeAssumeFEAT_LRCPC k = case unsafeCoerce Refl :: FEAT_LRCPC :~: True of Refl -> k++queryFEAT_LRCPC :: Maybe (Dict HasFEAT_LRCPC)+queryFEAT_LRCPC = case sFEAT_LRCPC of STrue -> unsafeAssumeFEAT_LRCPC (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_LRCPC #-}++unsafeAssumeFEAT_LRCPC2 :: (HasFEAT_LRCPC2 => a) -> a+unsafeAssumeFEAT_LRCPC2 k = case unsafeCoerce Refl :: FEAT_LRCPC2 :~: True of Refl -> k++queryFEAT_LRCPC2 :: Maybe (Dict HasFEAT_LRCPC2)+queryFEAT_LRCPC2 = case sFEAT_LRCPC2 of STrue -> unsafeAssumeFEAT_LRCPC2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_LRCPC2 #-}++unsafeAssumeFEAT_LSE :: (HasFEAT_LSE => a) -> a+unsafeAssumeFEAT_LSE k = case unsafeCoerce Refl :: FEAT_LSE :~: True of Refl -> k++queryFEAT_LSE :: Maybe (Dict HasFEAT_LSE)+queryFEAT_LSE = case sFEAT_LSE of STrue -> unsafeAssumeFEAT_LSE (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_LSE #-}++unsafeAssumeFEAT_LSE2 :: (HasFEAT_LSE2 => a) -> a+unsafeAssumeFEAT_LSE2 k = case unsafeCoerce Refl :: FEAT_LSE2 :~: True of Refl -> k++queryFEAT_LSE2 :: Maybe (Dict HasFEAT_LSE2)+queryFEAT_LSE2 = case sFEAT_LSE2 of STrue -> unsafeAssumeFEAT_LSE2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_LSE2 #-}++unsafeAssumeFEAT_PAuth :: (HasFEAT_PAuth => a) -> a+unsafeAssumeFEAT_PAuth k = case unsafeCoerce Refl :: FEAT_PAuth :~: True of Refl -> k++queryFEAT_PAuth :: Maybe (Dict HasFEAT_PAuth)+queryFEAT_PAuth = case sFEAT_PAuth of STrue -> unsafeAssumeFEAT_PAuth (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_PAuth #-}++unsafeAssumeFEAT_PAuth2 :: (HasFEAT_PAuth2 => a) -> a+unsafeAssumeFEAT_PAuth2 k = case unsafeCoerce Refl :: FEAT_PAuth2 :~: True of Refl -> k++queryFEAT_PAuth2 :: Maybe (Dict HasFEAT_PAuth2)+queryFEAT_PAuth2 = case sFEAT_PAuth2 of STrue -> unsafeAssumeFEAT_PAuth2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_PAuth2 #-}++unsafeAssumeFEAT_PMULL :: (HasFEAT_PMULL => a) -> a+unsafeAssumeFEAT_PMULL k = case unsafeCoerce Refl :: FEAT_PMULL :~: True of Refl -> k++queryFEAT_PMULL :: Maybe (Dict HasFEAT_PMULL)+queryFEAT_PMULL = case sFEAT_PMULL of STrue -> unsafeAssumeFEAT_PMULL (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_PMULL #-}++unsafeAssumeFEAT_RDM :: (HasFEAT_RDM => a) -> a+unsafeAssumeFEAT_RDM k = case unsafeCoerce Refl :: FEAT_RDM :~: True of Refl -> k++queryFEAT_RDM :: Maybe (Dict HasFEAT_RDM)+queryFEAT_RDM = case sFEAT_RDM of STrue -> unsafeAssumeFEAT_RDM (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_RDM #-}++unsafeAssumeFEAT_RPRES :: (HasFEAT_RPRES => a) -> a+unsafeAssumeFEAT_RPRES k = case unsafeCoerce Refl :: FEAT_RPRES :~: True of Refl -> k++queryFEAT_RPRES :: Maybe (Dict HasFEAT_RPRES)+queryFEAT_RPRES = case sFEAT_RPRES of STrue -> unsafeAssumeFEAT_RPRES (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_RPRES #-}++unsafeAssumeFEAT_SB :: (HasFEAT_SB => a) -> a+unsafeAssumeFEAT_SB k = case unsafeCoerce Refl :: FEAT_SB :~: True of Refl -> k++queryFEAT_SB :: Maybe (Dict HasFEAT_SB)+queryFEAT_SB = case sFEAT_SB of STrue -> unsafeAssumeFEAT_SB (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SB #-}++unsafeAssumeFEAT_SHA1 :: (HasFEAT_SHA1 => a) -> a+unsafeAssumeFEAT_SHA1 k = case unsafeCoerce Refl :: FEAT_SHA1 :~: True of Refl -> k++queryFEAT_SHA1 :: Maybe (Dict HasFEAT_SHA1)+queryFEAT_SHA1 = case sFEAT_SHA1 of STrue -> unsafeAssumeFEAT_SHA1 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SHA1 #-}++unsafeAssumeFEAT_SHA256 :: (HasFEAT_SHA256 => a) -> a+unsafeAssumeFEAT_SHA256 k = case unsafeCoerce Refl :: FEAT_SHA256 :~: True of Refl -> k++queryFEAT_SHA256 :: Maybe (Dict HasFEAT_SHA256)+queryFEAT_SHA256 = case sFEAT_SHA256 of STrue -> unsafeAssumeFEAT_SHA256 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SHA256 #-}++unsafeAssumeFEAT_SHA3 :: (HasFEAT_SHA3 => a) -> a+unsafeAssumeFEAT_SHA3 k = case unsafeCoerce Refl :: FEAT_SHA3 :~: True of Refl -> k++queryFEAT_SHA3 :: Maybe (Dict HasFEAT_SHA3)+queryFEAT_SHA3 = case sFEAT_SHA3 of STrue -> unsafeAssumeFEAT_SHA3 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SHA3 #-}++unsafeAssumeFEAT_SHA512 :: (HasFEAT_SHA512 => a) -> a+unsafeAssumeFEAT_SHA512 k = case unsafeCoerce Refl :: FEAT_SHA512 :~: True of Refl -> k++queryFEAT_SHA512 :: Maybe (Dict HasFEAT_SHA512)+queryFEAT_SHA512 = case sFEAT_SHA512 of STrue -> unsafeAssumeFEAT_SHA512 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SHA512 #-}++unsafeAssumeFEAT_SME :: (HasFEAT_SME => a) -> a+unsafeAssumeFEAT_SME k = case unsafeCoerce Refl :: FEAT_SME :~: True of Refl -> k++queryFEAT_SME :: Maybe (Dict HasFEAT_SME)+queryFEAT_SME = case sFEAT_SME of STrue -> unsafeAssumeFEAT_SME (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SME #-}++unsafeAssumeFEAT_SME_F64F64 :: (HasFEAT_SME_F64F64 => a) -> a+unsafeAssumeFEAT_SME_F64F64 k = case unsafeCoerce Refl :: FEAT_SME_F64F64 :~: True of Refl -> k++queryFEAT_SME_F64F64 :: Maybe (Dict HasFEAT_SME_F64F64)+queryFEAT_SME_F64F64 = case sFEAT_SME_F64F64 of STrue -> unsafeAssumeFEAT_SME_F64F64 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SME_F64F64 #-}++unsafeAssumeFEAT_SME_I16I64 :: (HasFEAT_SME_I16I64 => a) -> a+unsafeAssumeFEAT_SME_I16I64 k = case unsafeCoerce Refl :: FEAT_SME_I16I64 :~: True of Refl -> k++queryFEAT_SME_I16I64 :: Maybe (Dict HasFEAT_SME_I16I64)+queryFEAT_SME_I16I64 = case sFEAT_SME_I16I64 of STrue -> unsafeAssumeFEAT_SME_I16I64 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SME_I16I64 #-}++unsafeAssumeFEAT_SME2 :: (HasFEAT_SME2 => a) -> a+unsafeAssumeFEAT_SME2 k = case unsafeCoerce Refl :: FEAT_SME2 :~: True of Refl -> k++queryFEAT_SME2 :: Maybe (Dict HasFEAT_SME2)+queryFEAT_SME2 = case sFEAT_SME2 of STrue -> unsafeAssumeFEAT_SME2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SME2 #-}++unsafeAssumeFEAT_SPECRES :: (HasFEAT_SPECRES => a) -> a+unsafeAssumeFEAT_SPECRES k = case unsafeCoerce Refl :: FEAT_SPECRES :~: True of Refl -> k++queryFEAT_SPECRES :: Maybe (Dict HasFEAT_SPECRES)+queryFEAT_SPECRES = case sFEAT_SPECRES of STrue -> unsafeAssumeFEAT_SPECRES (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SPECRES #-}++unsafeAssumeFEAT_SSBS :: (HasFEAT_SSBS => a) -> a+unsafeAssumeFEAT_SSBS k = case unsafeCoerce Refl :: FEAT_SSBS :~: True of Refl -> k++queryFEAT_SSBS :: Maybe (Dict HasFEAT_SSBS)+queryFEAT_SSBS = case sFEAT_SSBS of STrue -> unsafeAssumeFEAT_SSBS (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SSBS #-}++unsafeAssumeFEAT_SVE :: (HasFEAT_SVE => a) -> a+unsafeAssumeFEAT_SVE k = case unsafeCoerce Refl :: FEAT_SVE :~: True of Refl -> k++queryFEAT_SVE :: Maybe (Dict HasFEAT_SVE)+queryFEAT_SVE = case sFEAT_SVE of STrue -> unsafeAssumeFEAT_SVE (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SVE #-}++unsafeAssumeFEAT_SVE2 :: (HasFEAT_SVE2 => a) -> a+unsafeAssumeFEAT_SVE2 k = case unsafeCoerce Refl :: FEAT_SVE2 :~: True of Refl -> k++queryFEAT_SVE2 :: Maybe (Dict HasFEAT_SVE2)+queryFEAT_SVE2 = case sFEAT_SVE2 of STrue -> unsafeAssumeFEAT_SVE2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_SVE2 #-}++unsafeAssumeFEAT_WFxT :: (HasFEAT_WFxT => a) -> a+unsafeAssumeFEAT_WFxT k = case unsafeCoerce Refl :: FEAT_WFxT :~: True of Refl -> k++queryFEAT_WFxT :: Maybe (Dict HasFEAT_WFxT)+queryFEAT_WFxT = case sFEAT_WFxT of STrue -> unsafeAssumeFEAT_WFxT (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFEAT_WFxT #-}

+ src/System/CPUFeatures/Arm/TypeBool.hs view

@@ -0,0 +1,200 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{- |+Description: Arm features as type-level booleans++This module provides the type-level interface to detect CPU features.+You can mark your function with @\<FEATURE NAME\> ~ True =>@ to indicate that+it requires a specific CPU feature.+You can detect the availability and get the constraint @\<FEATURE NAME\> ~ True@+by pattern-matching on the variable @s\<FEATURE NAME\>@.++Example:++> -- This function requires FEAT_PMULL+> someFunction :: FEAT_PMULL ~ True => ...+>+> case sFEAT_PMULL of+>   STrue -> {- In this branch, FEAT_PMULL is True -} someFunction+>   SFalse -> {- In this branch, FEAT_PMULL is False -} error "FEAT_PMULL not available"+-}+module System.CPUFeatures.Arm.TypeBool+  (FEAT_AES, sFEAT_AES+  ,FEAT_AFP, sFEAT_AFP+  ,FEAT_BF16, sFEAT_BF16+  ,FEAT_BTI, sFEAT_BTI+  ,FEAT_CSV2, sFEAT_CSV2+  ,FEAT_CSV3, sFEAT_CSV3+  ,FEAT_DIT, sFEAT_DIT+  ,FEAT_DotProd, sFEAT_DotProd+  ,FEAT_DPB, sFEAT_DPB+  ,FEAT_DPB2, sFEAT_DPB2+  ,FEAT_ECV, sFEAT_ECV+  ,FEAT_FCMA, sFEAT_FCMA+  ,FEAT_FHM, sFEAT_FHM+  ,FEAT_FlagM, sFEAT_FlagM+  ,FEAT_FlagM2, sFEAT_FlagM2+  ,FEAT_FP16, sFEAT_FP16+  ,FEAT_FPAC, sFEAT_FPAC+  ,FEAT_FRINTTS, sFEAT_FRINTTS+  ,FEAT_I8MM, sFEAT_I8MM+  ,FEAT_JSCVT, sFEAT_JSCVT+  ,FEAT_LRCPC, sFEAT_LRCPC+  ,FEAT_LRCPC2, sFEAT_LRCPC2+  ,FEAT_LSE, sFEAT_LSE+  ,FEAT_LSE2, sFEAT_LSE2+  ,FEAT_PAuth, sFEAT_PAuth+  ,FEAT_PAuth2, sFEAT_PAuth2+  ,FEAT_PMULL, sFEAT_PMULL+  ,FEAT_RDM, sFEAT_RDM+  ,FEAT_RPRES, sFEAT_RPRES+  ,FEAT_SB, sFEAT_SB+  ,FEAT_SHA1, sFEAT_SHA1+  ,FEAT_SHA256, sFEAT_SHA256+  ,FEAT_SHA3, sFEAT_SHA3+  ,FEAT_SHA512, sFEAT_SHA512+  ,FEAT_SME, sFEAT_SME+  ,FEAT_SME_F64F64, sFEAT_SME_F64F64+  ,FEAT_SME_I16I64, sFEAT_SME_I16I64+  ,FEAT_SME2, sFEAT_SME2+  ,FEAT_SPECRES, sFEAT_SPECRES+  ,FEAT_SSBS, sFEAT_SSBS+  ,FEAT_SVE, sFEAT_SVE+  ,FEAT_SVE2, sFEAT_SVE2+  ,FEAT_WFxT, sFEAT_WFxT+  ,SBool(..)+  ) where+import System.CPUFeatures.Arm.Bool+import System.CPUFeatures.Util++type family FEAT_AES :: Bool -- optional from Armv8.0+type family FEAT_AFP :: Bool+type family FEAT_BF16 :: Bool -- optional from Armv8.2, mandatory from Armv8.6+type family FEAT_BTI :: Bool -- optional from Armv8.4, mandatory from Armv8.5+type family FEAT_CSV2 :: Bool -- optional from Armv8.0, mandatory from Armv8.5+type family FEAT_CSV3 :: Bool -- optional from Armv8.0, mandatory from Armv8.5+type family FEAT_DIT :: Bool -- optional from Armv8.3, mandatory from Armv8.4+type family FEAT_DotProd :: Bool -- optional from Armv8.1+type family FEAT_DPB :: Bool -- optional from Armv8.1, mandatory from Armv8.2+type family FEAT_DPB2 :: Bool -- optional from Armv8.1, mandatory from Armv8.5+type family FEAT_ECV :: Bool -- optional from Armv8.5, mandatory from Armv8.6+type family FEAT_FCMA :: Bool -- optional from Armv8.2+type family FEAT_FHM :: Bool -- optional from Armv8.1+type family FEAT_FlagM :: Bool -- optional from Armv8.1, mandatory from Armv8.4+type family FEAT_FlagM2 :: Bool -- optional from Armv8.4+type family FEAT_FP16 :: Bool -- optional from Armv8.2+type family FEAT_FPAC :: Bool -- optional from Armv8.2+type family FEAT_FRINTTS :: Bool -- optional from Armv8.4+type family FEAT_I8MM :: Bool -- optional from Armv8.1, mandatory from Armv8.6+type family FEAT_JSCVT :: Bool -- optional from Armv8.2+type family FEAT_LRCPC :: Bool -- optional from Armv8.2, mandatory from Armv8.3+type family FEAT_LRCPC2 :: Bool -- optional from Armv8.2, mandatory from Armv8.4+type family FEAT_LSE :: Bool -- optional from Armv8.0, mandatory from Armv8.1+type family FEAT_LSE2 :: Bool -- optional from Armv8.2, mandatory from Armv8.4+type family FEAT_PAuth :: Bool -- optional from Armv8.2, mandatory from Armv8.3+type family FEAT_PAuth2 :: Bool -- optional from Armv8.2, mandatory from Armv8.6+type family FEAT_PMULL :: Bool -- optional from Armv8.0+type family FEAT_RDM :: Bool -- optional from Armv8.0+type family FEAT_RPRES :: Bool -- optional from Armv8.0+type family FEAT_SB :: Bool -- optional from Armv8.0, mandatory from Armv8.5+type family FEAT_SHA1 :: Bool -- optional from Armv8.0+type family FEAT_SHA256 :: Bool -- optional from Armv8.0+type family FEAT_SHA3 :: Bool -- optional from Armv8.1+type family FEAT_SHA512 :: Bool -- optional from Armv8.1+type family FEAT_SME :: Bool+type family FEAT_SME_F64F64 :: Bool+type family FEAT_SME_I16I64 :: Bool+type family FEAT_SME2 :: Bool+type family FEAT_SPECRES :: Bool -- optional from Armv8.0, mandatory from Armv8.5+type family FEAT_SSBS :: Bool -- optional from Armv8.0+type family FEAT_SVE :: Bool -- optional from Armv8.2+type family FEAT_SVE2 :: Bool -- optional from Armv9.0+type family FEAT_WFxT :: Bool++sFEAT_AES :: SBool FEAT_AES+sFEAT_AFP :: SBool FEAT_AFP+sFEAT_BF16 :: SBool FEAT_BF16+sFEAT_BTI :: SBool FEAT_BTI+sFEAT_CSV2 :: SBool FEAT_CSV2+sFEAT_CSV3 :: SBool FEAT_CSV3+sFEAT_DIT :: SBool FEAT_DIT+sFEAT_DotProd :: SBool FEAT_DotProd+sFEAT_DPB :: SBool FEAT_DPB+sFEAT_DPB2 :: SBool FEAT_DPB2+sFEAT_ECV :: SBool FEAT_ECV+sFEAT_FCMA :: SBool FEAT_FCMA+sFEAT_FHM :: SBool FEAT_FHM+sFEAT_FlagM :: SBool FEAT_FlagM+sFEAT_FlagM2 :: SBool FEAT_FlagM2+sFEAT_FP16 :: SBool FEAT_FP16+sFEAT_FPAC :: SBool FEAT_FPAC+sFEAT_FRINTTS :: SBool FEAT_FRINTTS+sFEAT_I8MM :: SBool FEAT_I8MM+sFEAT_JSCVT :: SBool FEAT_JSCVT+sFEAT_LRCPC :: SBool FEAT_LRCPC+sFEAT_LRCPC2 :: SBool FEAT_LRCPC2+sFEAT_LSE :: SBool FEAT_LSE+sFEAT_LSE2 :: SBool FEAT_LSE2+sFEAT_PAuth :: SBool FEAT_PAuth+sFEAT_PAuth2 :: SBool FEAT_PAuth2+sFEAT_PMULL :: SBool FEAT_PMULL+sFEAT_RDM :: SBool FEAT_RDM+sFEAT_RPRES :: SBool FEAT_RPRES+sFEAT_SB :: SBool FEAT_SB+sFEAT_SHA1 :: SBool FEAT_SHA1+sFEAT_SHA256 :: SBool FEAT_SHA256+sFEAT_SHA3 :: SBool FEAT_SHA3+sFEAT_SHA512 :: SBool FEAT_SHA512+sFEAT_SME :: SBool FEAT_SME+sFEAT_SME_F64F64 :: SBool FEAT_SME_F64F64+sFEAT_SME_I16I64 :: SBool FEAT_SME_I16I64+sFEAT_SME2 :: SBool FEAT_SME2+sFEAT_SPECRES :: SBool FEAT_SPECRES+sFEAT_SSBS :: SBool FEAT_SSBS+sFEAT_SVE :: SBool FEAT_SVE+sFEAT_SVE2 :: SBool FEAT_SVE2+sFEAT_WFxT :: SBool FEAT_WFxT++sFEAT_AES = unsafeBoolToSBool bFEAT_AES+sFEAT_AFP = unsafeBoolToSBool bFEAT_AFP+sFEAT_BF16 = unsafeBoolToSBool bFEAT_BF16+sFEAT_BTI = unsafeBoolToSBool bFEAT_BTI+sFEAT_CSV2 = unsafeBoolToSBool bFEAT_CSV2+sFEAT_CSV3 = unsafeBoolToSBool bFEAT_CSV3+sFEAT_DIT = unsafeBoolToSBool bFEAT_DIT+sFEAT_DotProd = unsafeBoolToSBool bFEAT_DotProd+sFEAT_DPB = unsafeBoolToSBool bFEAT_DPB+sFEAT_DPB2 = unsafeBoolToSBool bFEAT_DPB2+sFEAT_ECV = unsafeBoolToSBool bFEAT_ECV+sFEAT_FCMA = unsafeBoolToSBool bFEAT_FCMA+sFEAT_FHM = unsafeBoolToSBool bFEAT_FHM+sFEAT_FlagM = unsafeBoolToSBool bFEAT_FlagM+sFEAT_FlagM2 = unsafeBoolToSBool bFEAT_FlagM2+sFEAT_FP16 = unsafeBoolToSBool bFEAT_FP16+sFEAT_FPAC = unsafeBoolToSBool bFEAT_FPAC+sFEAT_FRINTTS = unsafeBoolToSBool bFEAT_FRINTTS+sFEAT_I8MM = unsafeBoolToSBool bFEAT_I8MM+sFEAT_JSCVT = unsafeBoolToSBool bFEAT_JSCVT+sFEAT_LRCPC = unsafeBoolToSBool bFEAT_LRCPC+sFEAT_LRCPC2 = unsafeBoolToSBool bFEAT_LRCPC2+sFEAT_LSE = unsafeBoolToSBool bFEAT_LSE+sFEAT_LSE2 = unsafeBoolToSBool bFEAT_LSE2+sFEAT_PAuth = unsafeBoolToSBool bFEAT_PAuth+sFEAT_PAuth2 = unsafeBoolToSBool bFEAT_PAuth2+sFEAT_PMULL = unsafeBoolToSBool bFEAT_PMULL+sFEAT_RDM = unsafeBoolToSBool bFEAT_RDM+sFEAT_RPRES = unsafeBoolToSBool bFEAT_RPRES+sFEAT_SB = unsafeBoolToSBool bFEAT_SB+sFEAT_SHA1 = unsafeBoolToSBool bFEAT_SHA1+sFEAT_SHA256 = unsafeBoolToSBool bFEAT_SHA256+sFEAT_SHA3 = unsafeBoolToSBool bFEAT_SHA3+sFEAT_SHA512 = unsafeBoolToSBool bFEAT_SHA512+sFEAT_SME = unsafeBoolToSBool bFEAT_SME+sFEAT_SME_F64F64 = unsafeBoolToSBool bFEAT_SME_F64F64+sFEAT_SME_I16I64 = unsafeBoolToSBool bFEAT_SME_I16I64+sFEAT_SME2 = unsafeBoolToSBool bFEAT_SME2+sFEAT_SPECRES = unsafeBoolToSBool bFEAT_SPECRES+sFEAT_SSBS = unsafeBoolToSBool bFEAT_SSBS+sFEAT_SVE = unsafeBoolToSBool bFEAT_SVE+sFEAT_SVE2 = unsafeBoolToSBool bFEAT_SVE2+sFEAT_WFxT = unsafeBoolToSBool bFEAT_WFxT

+ src/System/CPUFeatures/RISCV.hs view

@@ -0,0 +1,4 @@+module System.CPUFeatures.RISCV+  (module System.CPUFeatures.RISCV.Bool+  ) where+import System.CPUFeatures.RISCV.Bool

+ src/System/CPUFeatures/RISCV/Bool.hs view

@@ -0,0 +1,368 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+{- |+Description: Detect RISC-V features at runtime++This module provides the basic interface to detect CPU features.+The availability is indicated by a boolean variable (@b\<FEATRUE NAME\>@).+-}+module System.CPUFeatures.RISCV.Bool+  (bC+  ,bV+  ,bZba+  ,bZbb+  ,bZbs+  ,bZicboz+  ,bZbc+  ,bZbkb+  ,bZbkc+  ,bZbkx+  ,bZknd+  ,bZkne+  ,bZknh+  ,bZksed+  ,bZksh+  ,bZkt+  ,bZvbb+  ,bZvbc+  ,bZvkb+  ,bZvkg+  ,bZvkned+  ,bZvknha+  ,bZvknhb+  ,bZvksed+  ,bZvksh+  ,bZvkt+  ,bZfh+  ,bZfhmin+  ,bZihintntl+  ,bZvfh+  ,bZvfhmin+  ,bZfa+  ,bZtso+  ,bZacas+  ,bZicntr+  ,bZicond+  ,bZihintpause+  ,bZihpm+  ,bZve32x+  ,bZve32f+  ,bZve64x+  ,bZve64f+  ,bZve64d+  ,bZimop+  ,bZca+  ,bZcb+  ,bZcd+  ,bZcf+  ,bZcmop+  ,bZawrs+  ,bZaamo+  ,bZalrsc+  ,bSupm+  ,bZfbfmin+  ,bZvfbfmin+  ,bZvfbfwma+  ,bZicbom+  ) where+#if defined(riscv64_HOST_ARCH) && defined(linux_HOST_OS)+import Data.Bits ((.&.))+import Hwcap+import Hwprobe+#endif++bC :: Bool+bV :: Bool+bZba :: Bool+bZbb :: Bool+bZbs :: Bool+bZicboz :: Bool+bZbc :: Bool+bZbkb :: Bool+bZbkc :: Bool+bZbkx :: Bool+bZknd :: Bool+bZkne :: Bool+bZknh :: Bool+bZksed :: Bool+bZksh :: Bool+bZkt :: Bool+bZvbb :: Bool+bZvbc :: Bool+bZvkb :: Bool+bZvkg :: Bool+bZvkned :: Bool+bZvknha :: Bool+bZvknhb :: Bool+bZvksed :: Bool+bZvksh :: Bool+bZvkt :: Bool+bZfh :: Bool+bZfhmin :: Bool+bZihintntl :: Bool+bZvfh :: Bool+bZvfhmin :: Bool+bZfa :: Bool+bZtso :: Bool+bZacas :: Bool+bZicntr :: Bool+bZicond :: Bool+bZihintpause :: Bool+bZihpm :: Bool+bZve32x :: Bool+bZve32f :: Bool+bZve64x :: Bool+bZve64f :: Bool+bZve64d :: Bool+bZimop :: Bool+bZca :: Bool+bZcb :: Bool+bZcd :: Bool+bZcf :: Bool+bZcmop :: Bool+bZawrs :: Bool+bZaamo :: Bool+bZalrsc :: Bool+bSupm :: Bool+bZfbfmin :: Bool+bZvfbfmin :: Bool+bZvfbfwma :: Bool+bZicbom :: Bool++#if defined(riscv64_HOST_ARCH) && defined(linux_HOST_OS)++bC = hwcap .&. hwcap_C /= 0+bV = hwcap .&. hwcap_V /= 0+-- bC = hwprobe_ima_ext_0 .&. hwprobe_IMA_C /= 0+-- bV = hwprobe_ima_ext_0 .&. hwprobe_IMA_V /= 0+bZba = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBA /= 0+bZbb = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBB /= 0+bZbs = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBS /= 0+bZicboz = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZICBOZ /= 0+bZbc = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBC /= 0+bZbkb = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBKB /= 0+bZbkc = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBKC /= 0+bZbkx = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZBKX /= 0+bZknd = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZKND /= 0+bZkne = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZKNE /= 0+bZknh = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZKNH /= 0+bZksed = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZKSED /= 0+bZksh = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZKSH /= 0+bZkt = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZKT /= 0+bZvbb = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVBB /= 0+bZvbc = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVBC /= 0+bZvkb = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKB /= 0+bZvkg = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKG /= 0+bZvkned = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKNED /= 0+bZvknha = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKNHA /= 0+bZvknhb = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKNHB /= 0+bZvksed = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKSED /= 0+bZvksh = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKSH /= 0+bZvkt = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVKT /= 0+bZfh = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZFH /= 0+bZfhmin = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZFHMIN /= 0+bZihintntl = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZIHINTNTL /= 0+bZvfh = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVFH /= 0+bZvfhmin = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVFHMIN /= 0+bZfa = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZFA /= 0+bZtso = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZTSO /= 0+bZacas = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZACAS /= 0+bZicntr = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZICNTR /= 0+bZicond = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZICOND /= 0+bZihintpause = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZIHINTPAUSE /= 0+bZihpm = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZIHPM /= 0+bZve32x = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVE32X /= 0+bZve32f = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVE32F /= 0+bZve64x = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVE64X /= 0+bZve64f = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVE64F /= 0+bZve64d = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVE64D /= 0+bZimop = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZIMOP /= 0+bZca = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZCA /= 0+bZcb = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZCB /= 0+bZcd = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZCD /= 0+bZcf = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZCF /= 0+bZcmop = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZCMOP /= 0+bZawrs = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZAWRS /= 0+bZaamo = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZAAMO /= 0+bZalrsc = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZALRSC /= 0+bSupm = hwprobe_ima_ext_0 .&. hwprobe_EXT_SUPM /= 0+bZfbfmin = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZFBFMIN /= 0+bZvfbfmin = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVFBFMIN /= 0+bZvfbfwma = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZVFBFWMA /= 0+bZicbom = hwprobe_ima_ext_0 .&. hwprobe_EXT_ZICBOM /= 0++#else++{-# INLINE bC #-}+bC = False++{-# INLINE bV #-}+bV = False++{-# INLINE bZba #-}+bZba = False++{-# INLINE bZbb #-}+bZbb = False++{-# INLINE bZbs #-}+bZbs = False++{-# INLINE bZicboz #-}+bZicboz = False++{-# INLINE bZbc #-}+bZbc = False++{-# INLINE bZbkb #-}+bZbkb = False++{-# INLINE bZbkc #-}+bZbkc = False++{-# INLINE bZbkx #-}+bZbkx = False++{-# INLINE bZknd #-}+bZknd = False++{-# INLINE bZkne #-}+bZkne = False++{-# INLINE bZknh #-}+bZknh = False++{-# INLINE bZksed #-}+bZksed = False++{-# INLINE bZksh #-}+bZksh = False++{-# INLINE bZkt #-}+bZkt = False++{-# INLINE bZvbb #-}+bZvbb = False++{-# INLINE bZvbc #-}+bZvbc = False++{-# INLINE bZvkb #-}+bZvkb = False++{-# INLINE bZvkg #-}+bZvkg = False++{-# INLINE bZvkned #-}+bZvkned = False++{-# INLINE bZvknha #-}+bZvknha = False++{-# INLINE bZvknhb #-}+bZvknhb = False++{-# INLINE bZvksed #-}+bZvksed = False++{-# INLINE bZvksh #-}+bZvksh = False++{-# INLINE bZvkt #-}+bZvkt = False++{-# INLINE bZfh #-}+bZfh = False++{-# INLINE bZfhmin #-}+bZfhmin = False++{-# INLINE bZihintntl #-}+bZihintntl = False++{-# INLINE bZvfh #-}+bZvfh = False++{-# INLINE bZvfhmin #-}+bZvfhmin = False++{-# INLINE bZfa #-}+bZfa = False++{-# INLINE bZtso #-}+bZtso = False++{-# INLINE bZacas #-}+bZacas = False++{-# INLINE bZicntr #-}+bZicntr = False++{-# INLINE bZicond #-}+bZicond = False++{-# INLINE bZihintpause #-}+bZihintpause = False++{-# INLINE bZihpm #-}+bZihpm = False++{-# INLINE bZve32x #-}+bZve32x = False++{-# INLINE bZve32f #-}+bZve32f = False++{-# INLINE bZve64x #-}+bZve64x = False++{-# INLINE bZve64f #-}+bZve64f = False++{-# INLINE bZve64d #-}+bZve64d = False++{-# INLINE bZimop #-}+bZimop = False++{-# INLINE bZca #-}+bZca = False++{-# INLINE bZcb #-}+bZcb = False++{-# INLINE bZcd #-}+bZcd = False++{-# INLINE bZcf #-}+bZcf = False++{-# INLINE bZcmop #-}+bZcmop = False++{-# INLINE bZawrs #-}+bZawrs = False++{-# INLINE bZaamo #-}+bZaamo = False++{-# INLINE bZalrsc #-}+bZalrsc = False++{-# INLINE bSupm #-}+bSupm = False++{-# INLINE bZfbfmin #-}+bZfbfmin = False++{-# INLINE bZvfbfmin #-}+bZvfbfmin = False++{-# INLINE bZvfbfwma #-}+bZvfbfwma = False++{-# INLINE bZicbom #-}+bZicbom = False++#endif

+ src/System/CPUFeatures/RISCV/Constraint.hs view

@@ -0,0 +1,79 @@+{- |+Description: RISC-V features as nullary constraints++This module provides the constraint interface to detect CPU features.+You can mark your function with @Has\<FEATURE NAME\> =>@ to indicate that+it requires a specific CPU feature.+You can detect the availability and get the constraint @Has\<FEATURE NAME\>@+by pattern-matching on the variable @query\<FEATURE NAME\>@.++Example:++> -- This function requires the Vector extension+> someFunction :: HasV => ...+>+> case queryV of+>   Just Dict -> {- In this branch, HasV is available -} someFunction+>   Nothing -> {- In this branch, HasV is not available -} error "Vector extension not available"+-}+module System.CPUFeatures.RISCV.Constraint+  (HasC, queryC+  ,HasV, queryV+  ,HasZba, queryZba+  ,HasZbb, queryZbb+  ,HasZbs, queryZbs+  ,HasZicboz, queryZicboz+  ,HasZbc, queryZbc+  ,HasZbkb, queryZbkb+  ,HasZbkc, queryZbkc+  ,HasZbkx, queryZbkx+  ,HasZknd, queryZknd+  ,HasZkne, queryZkne+  ,HasZknh, queryZknh+  ,HasZksed, queryZksed+  ,HasZksh, queryZksh+  ,HasZkt, queryZkt+  ,HasZvbb, queryZvbb+  ,HasZvbc, queryZvbc+  ,HasZvkb, queryZvkb+  ,HasZvkg, queryZvkg+  ,HasZvkned, queryZvkned+  ,HasZvknha, queryZvknha+  ,HasZvknhb, queryZvknhb+  ,HasZvksed, queryZvksed+  ,HasZvksh, queryZvksh+  ,HasZvkt, queryZvkt+  ,HasZfh, queryZfh+  ,HasZfhmin, queryZfhmin+  ,HasZihintntl, queryZihintntl+  ,HasZvfh, queryZvfh+  ,HasZvfhmin, queryZvfhmin+  ,HasZfa, queryZfa+  ,HasZtso, queryZtso+  ,HasZacas, queryZacas+  ,HasZicntr, queryZicntr+  ,HasZicond, queryZicond+  ,HasZihintpause, queryZihintpause+  ,HasZihpm, queryZihpm+  ,HasZve32x, queryZve32x+  ,HasZve32f, queryZve32f+  ,HasZve64x, queryZve64x+  ,HasZve64f, queryZve64f+  ,HasZve64d, queryZve64d+  ,HasZimop, queryZimop+  ,HasZca, queryZca+  ,HasZcb, queryZcb+  ,HasZcd, queryZcd+  ,HasZcf, queryZcf+  ,HasZcmop, queryZcmop+  ,HasZawrs, queryZawrs+  ,HasZaamo, queryZaamo+  ,HasZalrsc, queryZalrsc+  ,HasSupm, querySupm+  ,HasZfbfmin, queryZfbfmin+  ,HasZvfbfmin, queryZvfbfmin+  ,HasZvfbfwma, queryZvfbfwma+  ,HasZicbom, queryZicbom+  ,Dict(Dict)+  ) where+import System.CPUFeatures.RISCV.Constraint.Unsafe

+ src/System/CPUFeatures/RISCV/Constraint/Unsafe.hs view

@@ -0,0 +1,581 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module System.CPUFeatures.RISCV.Constraint.Unsafe+  ( module System.CPUFeatures.RISCV.Constraint.Unsafe+  , Dict (Dict)+  ) where+import Data.Type.Equality ((:~:)(Refl))+import System.CPUFeatures.Util+import System.CPUFeatures.RISCV.TypeBool+import Unsafe.Coerce (unsafeCoerce)++class C ~ True => HasC+instance C ~ True => HasC++class V ~ True => HasV+instance V ~ True => HasV++class Zba ~ True => HasZba+instance Zba ~ True => HasZba++class Zbb ~ True => HasZbb+instance Zbb ~ True => HasZbb++class Zbs ~ True => HasZbs+instance Zbs ~ True => HasZbs++class Zicboz ~ True => HasZicboz+instance Zicboz ~ True => HasZicboz++class Zbc ~ True => HasZbc+instance Zbc ~ True => HasZbc++class Zbkb ~ True => HasZbkb+instance Zbkb ~ True => HasZbkb++class Zbkc ~ True => HasZbkc+instance Zbkc ~ True => HasZbkc++class Zbkx ~ True => HasZbkx+instance Zbkx ~ True => HasZbkx++class Zknd ~ True => HasZknd+instance Zknd ~ True => HasZknd++class Zkne ~ True => HasZkne+instance Zkne ~ True => HasZkne++class Zknh ~ True => HasZknh+instance Zknh ~ True => HasZknh++class Zksed ~ True => HasZksed+instance Zksed ~ True => HasZksed++class Zksh ~ True => HasZksh+instance Zksh ~ True => HasZksh++class Zkt ~ True => HasZkt+instance Zkt ~ True => HasZkt++class Zvbb ~ True => HasZvbb+instance Zvbb ~ True => HasZvbb++class Zvbc ~ True => HasZvbc+instance Zvbc ~ True => HasZvbc++class Zvkb ~ True => HasZvkb+instance Zvkb ~ True => HasZvkb++class Zvkg ~ True => HasZvkg+instance Zvkg ~ True => HasZvkg++class Zvkned ~ True => HasZvkned+instance Zvkned ~ True => HasZvkned++class Zvknha ~ True => HasZvknha+instance Zvknha ~ True => HasZvknha++class Zvknhb ~ True => HasZvknhb+instance Zvknhb ~ True => HasZvknhb++class Zvksed ~ True => HasZvksed+instance Zvksed ~ True => HasZvksed++class Zvksh ~ True => HasZvksh+instance Zvksh ~ True => HasZvksh++class Zvkt ~ True => HasZvkt+instance Zvkt ~ True => HasZvkt++class Zfh ~ True => HasZfh+instance Zfh ~ True => HasZfh++class Zfhmin ~ True => HasZfhmin+instance Zfhmin ~ True => HasZfhmin++class Zihintntl ~ True => HasZihintntl+instance Zihintntl ~ True => HasZihintntl++class Zvfh ~ True => HasZvfh+instance Zvfh ~ True => HasZvfh++class Zvfhmin ~ True => HasZvfhmin+instance Zvfhmin ~ True => HasZvfhmin++class Zfa ~ True => HasZfa+instance Zfa ~ True => HasZfa++class Ztso ~ True => HasZtso+instance Ztso ~ True => HasZtso++class Zacas ~ True => HasZacas+instance Zacas ~ True => HasZacas++class Zicntr ~ True => HasZicntr+instance Zicntr ~ True => HasZicntr++class Zicond ~ True => HasZicond+instance Zicond ~ True => HasZicond++class Zihintpause ~ True => HasZihintpause+instance Zihintpause ~ True => HasZihintpause++class Zihpm ~ True => HasZihpm+instance Zihpm ~ True => HasZihpm++class Zve32x ~ True => HasZve32x+instance Zve32x ~ True => HasZve32x++class Zve32f ~ True => HasZve32f+instance Zve32f ~ True => HasZve32f++class Zve64x ~ True => HasZve64x+instance Zve64x ~ True => HasZve64x++class Zve64f ~ True => HasZve64f+instance Zve64f ~ True => HasZve64f++class Zve64d ~ True => HasZve64d+instance Zve64d ~ True => HasZve64d++class Zimop ~ True => HasZimop+instance Zimop ~ True => HasZimop++class Zca ~ True => HasZca+instance Zca ~ True => HasZca++class Zcb ~ True => HasZcb+instance Zcb ~ True => HasZcb++class Zcd ~ True => HasZcd+instance Zcd ~ True => HasZcd++class Zcf ~ True => HasZcf+instance Zcf ~ True => HasZcf++class Zcmop ~ True => HasZcmop+instance Zcmop ~ True => HasZcmop++class Zawrs ~ True => HasZawrs+instance Zawrs ~ True => HasZawrs++class Zaamo ~ True => HasZaamo+instance Zaamo ~ True => HasZaamo++class Zalrsc ~ True => HasZalrsc+instance Zalrsc ~ True => HasZalrsc++class Supm ~ True => HasSupm+instance Supm ~ True => HasSupm++class Zfbfmin ~ True => HasZfbfmin+instance Zfbfmin ~ True => HasZfbfmin++class Zvfbfmin ~ True => HasZvfbfmin+instance Zvfbfmin ~ True => HasZvfbfmin++class Zvfbfwma ~ True => HasZvfbfwma+instance Zvfbfwma ~ True => HasZvfbfwma++class Zicbom ~ True => HasZicbom+instance Zicbom ~ True => HasZicbom++unsafeAssumeC :: (HasC => a) -> a+unsafeAssumeC k = case unsafeCoerce Refl :: C :~: True of Refl -> k++queryC :: Maybe (Dict HasC)+queryC = case sC of STrue -> unsafeAssumeC (Just Dict); SFalse -> Nothing+{-# NOINLINE queryC #-}++unsafeAssumeV :: (HasV => a) -> a+unsafeAssumeV k = case unsafeCoerce Refl :: V :~: True of Refl -> k++queryV :: Maybe (Dict HasV)+queryV = case sV of STrue -> unsafeAssumeV (Just Dict); SFalse -> Nothing+{-# NOINLINE queryV #-}++unsafeAssumeZba :: (HasZba => a) -> a+unsafeAssumeZba k = case unsafeCoerce Refl :: Zba :~: True of Refl -> k++queryZba :: Maybe (Dict HasZba)+queryZba = case sZba of STrue -> unsafeAssumeZba (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZba #-}++unsafeAssumeZbb :: (HasZbb => a) -> a+unsafeAssumeZbb k = case unsafeCoerce Refl :: Zbb :~: True of Refl -> k++queryZbb :: Maybe (Dict HasZbb)+queryZbb = case sZbb of STrue -> unsafeAssumeZbb (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZbb #-}++unsafeAssumeZbs :: (HasZbs => a) -> a+unsafeAssumeZbs k = case unsafeCoerce Refl :: Zbs :~: True of Refl -> k++queryZbs :: Maybe (Dict HasZbs)+queryZbs = case sZbs of STrue -> unsafeAssumeZbs (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZbs #-}++unsafeAssumeZicboz :: (HasZicboz => a) -> a+unsafeAssumeZicboz k = case unsafeCoerce Refl :: Zicboz :~: True of Refl -> k++queryZicboz :: Maybe (Dict HasZicboz)+queryZicboz = case sZicboz of STrue -> unsafeAssumeZicboz (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZicboz #-}++unsafeAssumeZbc :: (HasZbc => a) -> a+unsafeAssumeZbc k = case unsafeCoerce Refl :: Zbc :~: True of Refl -> k++queryZbc :: Maybe (Dict HasZbc)+queryZbc = case sZbc of STrue -> unsafeAssumeZbc (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZbc #-}++unsafeAssumeZbkb :: (HasZbkb => a) -> a+unsafeAssumeZbkb k = case unsafeCoerce Refl :: Zbkb :~: True of Refl -> k++queryZbkb :: Maybe (Dict HasZbkb)+queryZbkb = case sZbkb of STrue -> unsafeAssumeZbkb (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZbkb #-}++unsafeAssumeZbkc :: (HasZbkc => a) -> a+unsafeAssumeZbkc k = case unsafeCoerce Refl :: Zbkc :~: True of Refl -> k++queryZbkc :: Maybe (Dict HasZbkc)+queryZbkc = case sZbkc of STrue -> unsafeAssumeZbkc (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZbkc #-}++unsafeAssumeZbkx :: (HasZbkx => a) -> a+unsafeAssumeZbkx k = case unsafeCoerce Refl :: Zbkx :~: True of Refl -> k++queryZbkx :: Maybe (Dict HasZbkx)+queryZbkx = case sZbkx of STrue -> unsafeAssumeZbkx (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZbkx #-}++unsafeAssumeZknd :: (HasZknd => a) -> a+unsafeAssumeZknd k = case unsafeCoerce Refl :: Zknd :~: True of Refl -> k++queryZknd :: Maybe (Dict HasZknd)+queryZknd = case sZknd of STrue -> unsafeAssumeZknd (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZknd #-}++unsafeAssumeZkne :: (HasZkne => a) -> a+unsafeAssumeZkne k = case unsafeCoerce Refl :: Zkne :~: True of Refl -> k++queryZkne :: Maybe (Dict HasZkne)+queryZkne = case sZkne of STrue -> unsafeAssumeZkne (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZkne #-}++unsafeAssumeZknh :: (HasZknh => a) -> a+unsafeAssumeZknh k = case unsafeCoerce Refl :: Zknh :~: True of Refl -> k++queryZknh :: Maybe (Dict HasZknh)+queryZknh = case sZknh of STrue -> unsafeAssumeZknh (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZknh #-}++unsafeAssumeZksed :: (HasZksed => a) -> a+unsafeAssumeZksed k = case unsafeCoerce Refl :: Zksed :~: True of Refl -> k++queryZksed :: Maybe (Dict HasZksed)+queryZksed = case sZksed of STrue -> unsafeAssumeZksed (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZksed #-}++unsafeAssumeZksh :: (HasZksh => a) -> a+unsafeAssumeZksh k = case unsafeCoerce Refl :: Zksh :~: True of Refl -> k++queryZksh :: Maybe (Dict HasZksh)+queryZksh = case sZksh of STrue -> unsafeAssumeZksh (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZksh #-}++unsafeAssumeZkt :: (HasZkt => a) -> a+unsafeAssumeZkt k = case unsafeCoerce Refl :: Zkt :~: True of Refl -> k++queryZkt :: Maybe (Dict HasZkt)+queryZkt = case sZkt of STrue -> unsafeAssumeZkt (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZkt #-}++unsafeAssumeZvbb :: (HasZvbb => a) -> a+unsafeAssumeZvbb k = case unsafeCoerce Refl :: Zvbb :~: True of Refl -> k++queryZvbb :: Maybe (Dict HasZvbb)+queryZvbb = case sZvbb of STrue -> unsafeAssumeZvbb (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvbb #-}++unsafeAssumeZvbc :: (HasZvbc => a) -> a+unsafeAssumeZvbc k = case unsafeCoerce Refl :: Zvbc :~: True of Refl -> k++queryZvbc :: Maybe (Dict HasZvbc)+queryZvbc = case sZvbc of STrue -> unsafeAssumeZvbc (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvbc #-}++unsafeAssumeZvkb :: (HasZvkb => a) -> a+unsafeAssumeZvkb k = case unsafeCoerce Refl :: Zvkb :~: True of Refl -> k++queryZvkb :: Maybe (Dict HasZvkb)+queryZvkb = case sZvkb of STrue -> unsafeAssumeZvkb (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvkb #-}++unsafeAssumeZvkg :: (HasZvkg => a) -> a+unsafeAssumeZvkg k = case unsafeCoerce Refl :: Zvkg :~: True of Refl -> k++queryZvkg :: Maybe (Dict HasZvkg)+queryZvkg = case sZvkg of STrue -> unsafeAssumeZvkg (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvkg #-}++unsafeAssumeZvkned :: (HasZvkned => a) -> a+unsafeAssumeZvkned k = case unsafeCoerce Refl :: Zvkned :~: True of Refl -> k++queryZvkned :: Maybe (Dict HasZvkned)+queryZvkned = case sZvkned of STrue -> unsafeAssumeZvkned (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvkned #-}++unsafeAssumeZvknha :: (HasZvknha => a) -> a+unsafeAssumeZvknha k = case unsafeCoerce Refl :: Zvknha :~: True of Refl -> k++queryZvknha :: Maybe (Dict HasZvknha)+queryZvknha = case sZvknha of STrue -> unsafeAssumeZvknha (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvknha #-}++unsafeAssumeZvknhb :: (HasZvknhb => a) -> a+unsafeAssumeZvknhb k = case unsafeCoerce Refl :: Zvknhb :~: True of Refl -> k++queryZvknhb :: Maybe (Dict HasZvknhb)+queryZvknhb = case sZvknhb of STrue -> unsafeAssumeZvknhb (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvknhb #-}++unsafeAssumeZvksed :: (HasZvksed => a) -> a+unsafeAssumeZvksed k = case unsafeCoerce Refl :: Zvksed :~: True of Refl -> k++queryZvksed :: Maybe (Dict HasZvksed)+queryZvksed = case sZvksed of STrue -> unsafeAssumeZvksed (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvksed #-}++unsafeAssumeZvksh :: (HasZvksh => a) -> a+unsafeAssumeZvksh k = case unsafeCoerce Refl :: Zvksh :~: True of Refl -> k++queryZvksh :: Maybe (Dict HasZvksh)+queryZvksh = case sZvksh of STrue -> unsafeAssumeZvksh (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvksh #-}++unsafeAssumeZvkt :: (HasZvkt => a) -> a+unsafeAssumeZvkt k = case unsafeCoerce Refl :: Zvkt :~: True of Refl -> k++queryZvkt :: Maybe (Dict HasZvkt)+queryZvkt = case sZvkt of STrue -> unsafeAssumeZvkt (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvkt #-}++unsafeAssumeZfh :: (HasZfh => a) -> a+unsafeAssumeZfh k = case unsafeCoerce Refl :: Zfh :~: True of Refl -> k++queryZfh :: Maybe (Dict HasZfh)+queryZfh = case sZfh of STrue -> unsafeAssumeZfh (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZfh #-}++unsafeAssumeZfhmin :: (HasZfhmin => a) -> a+unsafeAssumeZfhmin k = case unsafeCoerce Refl :: Zfhmin :~: True of Refl -> k++queryZfhmin :: Maybe (Dict HasZfhmin)+queryZfhmin = case sZfhmin of STrue -> unsafeAssumeZfhmin (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZfhmin #-}++unsafeAssumeZihintntl :: (HasZihintntl => a) -> a+unsafeAssumeZihintntl k = case unsafeCoerce Refl :: Zihintntl :~: True of Refl -> k++queryZihintntl :: Maybe (Dict HasZihintntl)+queryZihintntl = case sZihintntl of STrue -> unsafeAssumeZihintntl (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZihintntl #-}++unsafeAssumeZvfh :: (HasZvfh => a) -> a+unsafeAssumeZvfh k = case unsafeCoerce Refl :: Zvfh :~: True of Refl -> k++queryZvfh :: Maybe (Dict HasZvfh)+queryZvfh = case sZvfh of STrue -> unsafeAssumeZvfh (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvfh #-}++unsafeAssumeZvfhmin :: (HasZvfhmin => a) -> a+unsafeAssumeZvfhmin k = case unsafeCoerce Refl :: Zvfhmin :~: True of Refl -> k++queryZvfhmin :: Maybe (Dict HasZvfhmin)+queryZvfhmin = case sZvfhmin of STrue -> unsafeAssumeZvfhmin (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvfhmin #-}++unsafeAssumeZfa :: (HasZfa => a) -> a+unsafeAssumeZfa k = case unsafeCoerce Refl :: Zfa :~: True of Refl -> k++queryZfa :: Maybe (Dict HasZfa)+queryZfa = case sZfa of STrue -> unsafeAssumeZfa (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZfa #-}++unsafeAssumeZtso :: (HasZtso => a) -> a+unsafeAssumeZtso k = case unsafeCoerce Refl :: Ztso :~: True of Refl -> k++queryZtso :: Maybe (Dict HasZtso)+queryZtso = case sZtso of STrue -> unsafeAssumeZtso (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZtso #-}++unsafeAssumeZacas :: (HasZacas => a) -> a+unsafeAssumeZacas k = case unsafeCoerce Refl :: Zacas :~: True of Refl -> k++queryZacas :: Maybe (Dict HasZacas)+queryZacas = case sZacas of STrue -> unsafeAssumeZacas (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZacas #-}++unsafeAssumeZicntr :: (HasZicntr => a) -> a+unsafeAssumeZicntr k = case unsafeCoerce Refl :: Zicntr :~: True of Refl -> k++queryZicntr :: Maybe (Dict HasZicntr)+queryZicntr = case sZicntr of STrue -> unsafeAssumeZicntr (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZicntr #-}++unsafeAssumeZicond :: (HasZicond => a) -> a+unsafeAssumeZicond k = case unsafeCoerce Refl :: Zicond :~: True of Refl -> k++queryZicond :: Maybe (Dict HasZicond)+queryZicond = case sZicond of STrue -> unsafeAssumeZicond (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZicond #-}++unsafeAssumeZihintpause :: (HasZihintpause => a) -> a+unsafeAssumeZihintpause k = case unsafeCoerce Refl :: Zihintpause :~: True of Refl -> k++queryZihintpause :: Maybe (Dict HasZihintpause)+queryZihintpause = case sZihintpause of STrue -> unsafeAssumeZihintpause (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZihintpause #-}++unsafeAssumeZihpm :: (HasZihpm => a) -> a+unsafeAssumeZihpm k = case unsafeCoerce Refl :: Zihpm :~: True of Refl -> k++queryZihpm :: Maybe (Dict HasZihpm)+queryZihpm = case sZihpm of STrue -> unsafeAssumeZihpm (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZihpm #-}++unsafeAssumeZve32x :: (HasZve32x => a) -> a+unsafeAssumeZve32x k = case unsafeCoerce Refl :: Zve32x :~: True of Refl -> k++queryZve32x :: Maybe (Dict HasZve32x)+queryZve32x = case sZve32x of STrue -> unsafeAssumeZve32x (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZve32x #-}++unsafeAssumeZve32f :: (HasZve32f => a) -> a+unsafeAssumeZve32f k = case unsafeCoerce Refl :: Zve32f :~: True of Refl -> k++queryZve32f :: Maybe (Dict HasZve32f)+queryZve32f = case sZve32f of STrue -> unsafeAssumeZve32f (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZve32f #-}++unsafeAssumeZve64x :: (HasZve64x => a) -> a+unsafeAssumeZve64x k = case unsafeCoerce Refl :: Zve64x :~: True of Refl -> k++queryZve64x :: Maybe (Dict HasZve64x)+queryZve64x = case sZve64x of STrue -> unsafeAssumeZve64x (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZve64x #-}++unsafeAssumeZve64f :: (HasZve64f => a) -> a+unsafeAssumeZve64f k = case unsafeCoerce Refl :: Zve64f :~: True of Refl -> k++queryZve64f :: Maybe (Dict HasZve64f)+queryZve64f = case sZve64f of STrue -> unsafeAssumeZve64f (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZve64f #-}++unsafeAssumeZve64d :: (HasZve64d => a) -> a+unsafeAssumeZve64d k = case unsafeCoerce Refl :: Zve64d :~: True of Refl -> k++queryZve64d :: Maybe (Dict HasZve64d)+queryZve64d = case sZve64d of STrue -> unsafeAssumeZve64d (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZve64d #-}++unsafeAssumeZimop :: (HasZimop => a) -> a+unsafeAssumeZimop k = case unsafeCoerce Refl :: Zimop :~: True of Refl -> k++queryZimop :: Maybe (Dict HasZimop)+queryZimop = case sZimop of STrue -> unsafeAssumeZimop (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZimop #-}++unsafeAssumeZca :: (HasZca => a) -> a+unsafeAssumeZca k = case unsafeCoerce Refl :: Zca :~: True of Refl -> k++queryZca :: Maybe (Dict HasZca)+queryZca = case sZca of STrue -> unsafeAssumeZca (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZca #-}++unsafeAssumeZcb :: (HasZcb => a) -> a+unsafeAssumeZcb k = case unsafeCoerce Refl :: Zcb :~: True of Refl -> k++queryZcb :: Maybe (Dict HasZcb)+queryZcb = case sZcb of STrue -> unsafeAssumeZcb (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZcb #-}++unsafeAssumeZcd :: (HasZcd => a) -> a+unsafeAssumeZcd k = case unsafeCoerce Refl :: Zcd :~: True of Refl -> k++queryZcd :: Maybe (Dict HasZcd)+queryZcd = case sZcd of STrue -> unsafeAssumeZcd (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZcd #-}++unsafeAssumeZcf :: (HasZcf => a) -> a+unsafeAssumeZcf k = case unsafeCoerce Refl :: Zcf :~: True of Refl -> k++queryZcf :: Maybe (Dict HasZcf)+queryZcf = case sZcf of STrue -> unsafeAssumeZcf (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZcf #-}++unsafeAssumeZcmop :: (HasZcmop => a) -> a+unsafeAssumeZcmop k = case unsafeCoerce Refl :: Zcmop :~: True of Refl -> k++queryZcmop :: Maybe (Dict HasZcmop)+queryZcmop = case sZcmop of STrue -> unsafeAssumeZcmop (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZcmop #-}++unsafeAssumeZawrs :: (HasZawrs => a) -> a+unsafeAssumeZawrs k = case unsafeCoerce Refl :: Zawrs :~: True of Refl -> k++queryZawrs :: Maybe (Dict HasZawrs)+queryZawrs = case sZawrs of STrue -> unsafeAssumeZawrs (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZawrs #-}++unsafeAssumeZaamo :: (HasZaamo => a) -> a+unsafeAssumeZaamo k = case unsafeCoerce Refl :: Zaamo :~: True of Refl -> k++queryZaamo :: Maybe (Dict HasZaamo)+queryZaamo = case sZaamo of STrue -> unsafeAssumeZaamo (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZaamo #-}++unsafeAssumeZalrsc :: (HasZalrsc => a) -> a+unsafeAssumeZalrsc k = case unsafeCoerce Refl :: Zalrsc :~: True of Refl -> k++queryZalrsc :: Maybe (Dict HasZalrsc)+queryZalrsc = case sZalrsc of STrue -> unsafeAssumeZalrsc (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZalrsc #-}++unsafeAssumeSupm :: (HasSupm => a) -> a+unsafeAssumeSupm k = case unsafeCoerce Refl :: Supm :~: True of Refl -> k++querySupm :: Maybe (Dict HasSupm)+querySupm = case sSupm of STrue -> unsafeAssumeSupm (Just Dict); SFalse -> Nothing+{-# NOINLINE querySupm #-}++unsafeAssumeZfbfmin :: (HasZfbfmin => a) -> a+unsafeAssumeZfbfmin k = case unsafeCoerce Refl :: Zfbfmin :~: True of Refl -> k++queryZfbfmin :: Maybe (Dict HasZfbfmin)+queryZfbfmin = case sZfbfmin of STrue -> unsafeAssumeZfbfmin (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZfbfmin #-}++unsafeAssumeZvfbfmin :: (HasZvfbfmin => a) -> a+unsafeAssumeZvfbfmin k = case unsafeCoerce Refl :: Zvfbfmin :~: True of Refl -> k++queryZvfbfmin :: Maybe (Dict HasZvfbfmin)+queryZvfbfmin = case sZvfbfmin of STrue -> unsafeAssumeZvfbfmin (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvfbfmin #-}++unsafeAssumeZvfbfwma :: (HasZvfbfwma => a) -> a+unsafeAssumeZvfbfwma k = case unsafeCoerce Refl :: Zvfbfwma :~: True of Refl -> k++queryZvfbfwma :: Maybe (Dict HasZvfbfwma)+queryZvfbfwma = case sZvfbfwma of STrue -> unsafeAssumeZvfbfwma (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZvfbfwma #-}++unsafeAssumeZicbom :: (HasZicbom => a) -> a+unsafeAssumeZicbom k = case unsafeCoerce Refl :: Zicbom :~: True of Refl -> k++queryZicbom :: Maybe (Dict HasZicbom)+queryZicbom = case sZicbom of STrue -> unsafeAssumeZicbom (Just Dict); SFalse -> Nothing+{-# NOINLINE queryZicbom #-}

+ src/System/CPUFeatures/RISCV/TypeBool.hs view

@@ -0,0 +1,312 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{- |+Description: RISC-V features as type-level booleans++This module provides the type-level interface to detect CPU features.+You can mark your function with @\<FEATURE NAME\> ~ True =>@ to indicate that+it requires a specific CPU feature.+You can detect the availability and get the constraint @\<FEATURE NAME\> ~ True@+by pattern-matching on the variable @s\<FEATURE NAME\>@.++Example:++> -- This function requires the Vector extension+> someFunction :: V ~ True => ...+>+> case sV of+>   STrue -> {- In this branch, V is True -} someFunction+>   SFalse -> {- In this branch, V is False -} error "Vector extension not available"+-}+module System.CPUFeatures.RISCV.TypeBool+  (C, sC+  ,V, sV+  ,Zba, sZba+  ,Zbb, sZbb+  ,Zbs, sZbs+  ,Zicboz, sZicboz+  ,Zbc, sZbc+  ,Zbkb, sZbkb+  ,Zbkc, sZbkc+  ,Zbkx, sZbkx+  ,Zknd, sZknd+  ,Zkne, sZkne+  ,Zknh, sZknh+  ,Zksed, sZksed+  ,Zksh, sZksh+  ,Zkt, sZkt+  ,Zvbb, sZvbb+  ,Zvbc, sZvbc+  ,Zvkb, sZvkb+  ,Zvkg, sZvkg+  ,Zvkned, sZvkned+  ,Zvknha, sZvknha+  ,Zvknhb, sZvknhb+  ,Zvksed, sZvksed+  ,Zvksh, sZvksh+  ,Zvkt, sZvkt+  ,Zfh, sZfh+  ,Zfhmin, sZfhmin+  ,Zihintntl, sZihintntl+  ,Zvfh, sZvfh+  ,Zvfhmin, sZvfhmin+  ,Zfa, sZfa+  ,Ztso, sZtso+  ,Zacas, sZacas+  ,Zicntr, sZicntr+  ,Zicond, sZicond+  ,Zihintpause, sZihintpause+  ,Zihpm, sZihpm+  ,Zve32x, sZve32x+  ,Zve32f, sZve32f+  ,Zve64x, sZve64x+  ,Zve64f, sZve64f+  ,Zve64d, sZve64d+  ,Zimop, sZimop+  ,Zca, sZca+  ,Zcb, sZcb+  ,Zcd, sZcd+  ,Zcf, sZcf+  ,Zcmop, sZcmop+  ,Zawrs, sZawrs+  ,Zaamo, sZaamo+  ,Zalrsc, sZalrsc+  ,Supm, sSupm+  ,Zfbfmin, sZfbfmin+  ,Zvfbfmin, sZvfbfmin+  ,Zvfbfwma, sZvfbfwma+  ,Zicbom, sZicbom+  ,SBool(..)+  ) where+import System.CPUFeatures.RISCV.Bool+import System.CPUFeatures.Util++type family C :: Bool+type family V :: Bool+type family Zba :: Bool+type family Zbb :: Bool+type family Zbs :: Bool+type family Zicboz :: Bool+type family Zbc :: Bool+type family Zbkb :: Bool+type family Zbkc :: Bool+type family Zbkx :: Bool+type family Zknd :: Bool+type family Zkne :: Bool+type family Zknh :: Bool+type family Zksed :: Bool+type family Zksh :: Bool+type family Zkt :: Bool+type family Zvbb :: Bool+type family Zvbc :: Bool+type family Zvkb :: Bool+type family Zvkg :: Bool+type family Zvkned :: Bool+type family Zvknha :: Bool+type family Zvknhb :: Bool+type family Zvksed :: Bool+type family Zvksh :: Bool+type family Zvkt :: Bool+type family Zfh :: Bool+type family Zfhmin :: Bool+type family Zihintntl :: Bool+type family Zvfh :: Bool+type family Zvfhmin :: Bool+type family Zfa :: Bool+type family Ztso :: Bool+type family Zacas :: Bool+type family Zicntr :: Bool+type family Zicond :: Bool+type family Zihintpause :: Bool+type family Zihpm :: Bool+type family Zve32x :: Bool+type family Zve32f :: Bool+type family Zve64x :: Bool+type family Zve64f :: Bool+type family Zve64d :: Bool+type family Zimop :: Bool+type family Zca :: Bool+type family Zcb :: Bool+type family Zcd :: Bool+type family Zcf :: Bool+type family Zcmop :: Bool+type family Zawrs :: Bool+type family Zaamo :: Bool+type family Zalrsc :: Bool+type family Supm :: Bool+type family Zfbfmin :: Bool+type family Zvfbfmin :: Bool+type family Zvfbfwma :: Bool+type family Zicbom :: Bool++sC :: SBool C+sC = unsafeBoolToSBool bC++sV :: SBool V+sV = unsafeBoolToSBool bV++sZba :: SBool Zba+sZba = unsafeBoolToSBool bZba++sZbb :: SBool Zbb+sZbb = unsafeBoolToSBool bZbb++sZbs :: SBool Zbs+sZbs = unsafeBoolToSBool bZbs++sZicboz :: SBool Zicboz+sZicboz = unsafeBoolToSBool bZicboz++sZbc :: SBool Zbc+sZbc = unsafeBoolToSBool bZbc++sZbkb :: SBool Zbkb+sZbkb = unsafeBoolToSBool bZbkb++sZbkc :: SBool Zbkc+sZbkc = unsafeBoolToSBool bZbkc++sZbkx :: SBool Zbkx+sZbkx = unsafeBoolToSBool bZbkx++sZknd :: SBool Zknd+sZknd = unsafeBoolToSBool bZknd++sZkne :: SBool Zkne+sZkne = unsafeBoolToSBool bZkne++sZknh :: SBool Zknh+sZknh = unsafeBoolToSBool bZknh++sZksed :: SBool Zksed+sZksed = unsafeBoolToSBool bZksed++sZksh :: SBool Zksh+sZksh = unsafeBoolToSBool bZksh++sZkt :: SBool Zkt+sZkt = unsafeBoolToSBool bZkt++sZvbb :: SBool Zvbb+sZvbb = unsafeBoolToSBool bZvbb++sZvbc :: SBool Zvbc+sZvbc = unsafeBoolToSBool bZvbc++sZvkb :: SBool Zvkb+sZvkb = unsafeBoolToSBool bZvkb++sZvkg :: SBool Zvkg+sZvkg = unsafeBoolToSBool bZvkg++sZvkned :: SBool Zvkned+sZvkned = unsafeBoolToSBool bZvkned++sZvknha :: SBool Zvknha+sZvknha = unsafeBoolToSBool bZvknha++sZvknhb :: SBool Zvknhb+sZvknhb = unsafeBoolToSBool bZvknhb++sZvksed :: SBool Zvksed+sZvksed = unsafeBoolToSBool bZvksed++sZvksh :: SBool Zvksh+sZvksh = unsafeBoolToSBool bZvksh++sZvkt :: SBool Zvkt+sZvkt = unsafeBoolToSBool bZvkt++sZfh :: SBool Zfh+sZfh = unsafeBoolToSBool bZfh++sZfhmin :: SBool Zfhmin+sZfhmin = unsafeBoolToSBool bZfhmin++sZihintntl :: SBool Zihintntl+sZihintntl = unsafeBoolToSBool bZihintntl++sZvfh :: SBool Zvfh+sZvfh = unsafeBoolToSBool bZvfh++sZvfhmin :: SBool Zvfhmin+sZvfhmin = unsafeBoolToSBool bZvfhmin++sZfa :: SBool Zfa+sZfa = unsafeBoolToSBool bZfa++sZtso :: SBool Ztso+sZtso = unsafeBoolToSBool bZtso++sZacas :: SBool Zacas+sZacas = unsafeBoolToSBool bZacas++sZicntr :: SBool Zicntr+sZicntr = unsafeBoolToSBool bZicntr++sZicond :: SBool Zicond+sZicond = unsafeBoolToSBool bZicond++sZihintpause :: SBool Zihintpause+sZihintpause = unsafeBoolToSBool bZihintpause++sZihpm :: SBool Zihpm+sZihpm = unsafeBoolToSBool bZihpm++sZve32x :: SBool Zve32x+sZve32x = unsafeBoolToSBool bZve32x++sZve32f :: SBool Zve32f+sZve32f = unsafeBoolToSBool bZve32f++sZve64x :: SBool Zve64x+sZve64x = unsafeBoolToSBool bZve64x++sZve64f :: SBool Zve64f+sZve64f = unsafeBoolToSBool bZve64f++sZve64d :: SBool Zve64d+sZve64d = unsafeBoolToSBool bZve64d++sZimop :: SBool Zimop+sZimop = unsafeBoolToSBool bZimop++sZca :: SBool Zca+sZca = unsafeBoolToSBool bZca++sZcb :: SBool Zcb+sZcb = unsafeBoolToSBool bZcb++sZcd :: SBool Zcd+sZcd = unsafeBoolToSBool bZcd++sZcf :: SBool Zcf+sZcf = unsafeBoolToSBool bZcf++sZcmop :: SBool Zcmop+sZcmop = unsafeBoolToSBool bZcmop++sZawrs :: SBool Zawrs+sZawrs = unsafeBoolToSBool bZawrs++sZaamo :: SBool Zaamo+sZaamo = unsafeBoolToSBool bZaamo++sZalrsc :: SBool Zalrsc+sZalrsc = unsafeBoolToSBool bZalrsc++sSupm :: SBool Supm+sSupm = unsafeBoolToSBool bSupm++sZfbfmin :: SBool Zfbfmin+sZfbfmin = unsafeBoolToSBool bZfbfmin++sZvfbfmin :: SBool Zvfbfmin+sZvfbfmin = unsafeBoolToSBool bZvfbfmin++sZvfbfwma :: SBool Zvfbfwma+sZvfbfwma = unsafeBoolToSBool bZvfbfwma++sZicbom :: SBool Zicbom+sZicbom = unsafeBoolToSBool bZicbom+

+ src/System/CPUFeatures/Util.hs view

@@ -0,0 +1,18 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+module System.CPUFeatures.Util where+import Data.Kind+import Unsafe.Coerce++type SBool :: Bool -> Type+data SBool x where+  STrue :: SBool True+  SFalse :: SBool False++unsafeBoolToSBool :: Bool -> SBool a+unsafeBoolToSBool True = unsafeCoerce STrue+unsafeBoolToSBool False = unsafeCoerce SFalse++type Dict :: Constraint -> Type+data Dict c = c => Dict

+ src/System/CPUFeatures/X86.hs view

@@ -0,0 +1,4 @@+module System.CPUFeatures.X86+  (module System.CPUFeatures.X86.Bool+  ) where+import System.CPUFeatures.X86.Bool

+ src/System/CPUFeatures/X86/Bool.hs view

@@ -0,0 +1,304 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+{- |+Description: Detect x86 features at runtime++This module provides the basic interface to detect CPU features.+The availability is indicated by a boolean variable (@b\<FEATRUE NAME\>@).+-}+module System.CPUFeatures.X86.Bool+  (bAESNI+  ,bAMX_BF16+  ,bAMX_FP16+  ,bAMX_INT8+  ,bAMX_TILE+  ,bAVX+  ,bAVX_VNNI+  ,bAVX10_1+  ,bAVX10_2+  ,bAVX2+  ,bAVX512_BF16+  ,bAVX512_BITALG+  ,bAVX512_FP16+  ,bAVX512_IFMA+  ,bAVX512_VBMI+  ,bAVX512_VBMI2+  ,bAVX512_VNNI+  ,bAVX512_VPOPCNTDQ+  ,bAVX512BW+  ,bAVX512CD+  ,bAVX512DQ+  ,bAVX512F+  ,bAVX512VL+  ,bBMI1+  ,bBMI2+  ,bF16C+  ,bFMA+  ,bGFNI+  ,bPCLMULQDQ+  ,bPOPCNT+  ,bRDRAND+  ,bSHA+  ,bSSE3+  ,bSSE4_1+  ,bSSE4_2+  ,bSSSE3+  ,bVAES+  ,bVPCLMULQDQ+  ,mAVX10+  ) where+#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)+import System.CPUFeatures.X86.Cpuid+import Data.Bits+-- import Data.Maybe (isJust)+#if defined(darwin_HOST_OS)+import GHC.Exts (Addr#)+#endif+#endif++bAESNI :: Bool+bAMX_BF16 :: Bool+bAMX_FP16 :: Bool+bAMX_INT8 :: Bool+bAMX_TILE :: Bool+bAVX :: Bool+bAVX_VNNI :: Bool+bAVX10_1 :: Bool+bAVX10_2 :: Bool+bAVX2 :: Bool+bAVX512_BF16 :: Bool+bAVX512_BITALG :: Bool+bAVX512_FP16 :: Bool+bAVX512_IFMA :: Bool+bAVX512_VBMI :: Bool+bAVX512_VBMI2 :: Bool+bAVX512_VNNI :: Bool+bAVX512_VPOPCNTDQ :: Bool+bAVX512BW :: Bool+bAVX512CD :: Bool+bAVX512DQ :: Bool+bAVX512F :: Bool+bAVX512VL :: Bool+bBMI1 :: Bool+bBMI2 :: Bool+bF16C :: Bool+bFMA :: Bool+bGFNI :: Bool+bPCLMULQDQ :: Bool+bPOPCNT :: Bool+bRDRAND :: Bool+bSHA :: Bool+bSSE3 :: Bool+bSSE4_1 :: Bool+bSSE4_2 :: Bool+bSSSE3 :: Bool+bVAES :: Bool+bVPCLMULQDQ :: Bool++mAVX10 :: Maybe Int++#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)++{-# NOINLINE cpuid_01 #-}+cpuid_01 :: CpuidResult+cpuid_01 = cpuid 0x1 0++{-# NOINLINE cpuid_07_0 #-}+cpuid_07_0 :: CpuidResult+cpuid_07_0 = cpuid 0x7 0++{-# NOINLINE cpuid_07_1 #-}+cpuid_07_1 :: CpuidResult+cpuid_07_1 = cpuid 0x7 1++{-# NOINLINE cpuid_24_0 #-}+cpuid_24_0 :: CpuidResult+cpuid_24_0 = cpuid 0x24 0++-- May be used by future AVX10+-- {-# NOINLINE cpuid_24_1 #-}+-- cpuid_24_1 :: CpuidResult+-- cpuid_24_1 = cpuid 0x24 1++#if defined(darwin_HOST_OS)+foreign import ccall unsafe hs_cpu_features_sysctl :: Addr# -> Bool+#endif++{-# NOINLINE mAVX10 #-}+mAVX10 | testBit (edx cpuid_07_1) 19+       , testBit (ecx cpuid_01) 27 -- OSXSAVE+       , (xgetbv 0 .&. 0xe6) == 0xe6 -- opmask, upper ZMM[0-15], ZMM[16-31], XMM, YMM+       , testBit (ebx cpuid_24_0) 17 -- AVX10/256+       = let !version = fromIntegral (ebx cpuid_24_0 .&. 0xff)+         in Just version+       | otherwise = Nothing++bAESNI = testBit (ecx cpuid_01) 25+bAMX_BF16 = testBit (edx cpuid_07_0) 22+bAMX_FP16 = testBit (eax cpuid_07_1) 21+bAMX_INT8 = testBit (edx cpuid_07_0) 25+bAMX_TILE = testBit (edx cpuid_07_0) 24+{-# NOINLINE bAVX #-}+bAVX = (ecx cpuid_01 .&. (bit 27 .|. bit 28)) == bit 27 .|. bit 28 && (xgetbv 0 .&. 6) == 6 -- bit 27: OSXSAVE, bit 28: AVX+bAVX_VNNI = testBit (eax cpuid_07_1) 4+bAVX10_1 = mAVX10 >= Just 1+bAVX10_2 = mAVX10 >= Just 2+-- bAVX10_VL256 = isJust mAVX10 -- mAVX10 checks for VL256+-- bAVX10_VL512 = isJust mAVX10 && testBit (ebx cpuid_24_0) 18+bAVX2 = bAVX && testBit (ebx cpuid_07_0) 5+bAVX512_BF16 = bAVX512F && testBit (eax cpuid_07_1) 5+bAVX512_BITALG = bAVX512F && testBit (ecx cpuid_07_0) 12+bAVX512_FP16 = bAVX512F && testBit (edx cpuid_07_0) 23+bAVX512_IFMA = bAVX512F && testBit (ebx cpuid_07_0) 21+bAVX512_VBMI = bAVX512F && testBit (ecx cpuid_07_0) 1+bAVX512_VBMI2 = bAVX512F && testBit (ecx cpuid_07_0) 6+bAVX512_VNNI = bAVX512F && testBit (ecx cpuid_07_0) 11+-- bAVX512_VP2INTERSECT = bAVX512F && testBit (edx cpuid_07_0) 8+bAVX512_VPOPCNTDQ = bAVX512F && testBit (ecx cpuid_07_0) 14+bAVX512BW = bAVX512F && testBit (ebx cpuid_07_0) 30+bAVX512CD = bAVX512F && testBit (ebx cpuid_07_0) 28+bAVX512DQ = bAVX512F && testBit (ebx cpuid_07_0) 17+{-# NOINLINE bAVX512F #-}+#if defined(darwin_HOST_OS)+bAVX512F = hs_cpu_features_sysctl "hw.optional.avx512f"# -- AVX-512 support on macOS is on-demand, that is, XCR0 is cleared by default.+#else+bAVX512F = testBit (ecx cpuid_01) 27 && (xgetbv 0 .&. 0xe6) == 0xe6 && testBit (ebx cpuid_07_0) 16 -- CPUID.1:ECX[bit 27]: OSXSAVE+#endif+bAVX512VL = testBit (ebx cpuid_07_0) 31+bBMI1 = testBit (ebx cpuid_07_0) 3+bBMI2 = testBit (ebx cpuid_07_0) 8+bF16C = bAVX && testBit (ecx cpuid_01) 29+bFMA = bAVX && testBit (ecx cpuid_01) 12+bGFNI = testBit (ecx cpuid_07_0) 8+bPCLMULQDQ = testBit (ecx cpuid_01) 1+bPOPCNT = testBit (ecx cpuid_01) 23+bRDRAND = testBit (ecx cpuid_01) 30+bSHA = testBit (ebx cpuid_07_0) 29+bSSE3 = testBit (ecx cpuid_01) 0+bSSE4_1 = testBit (ecx cpuid_01) 19+bSSE4_2 = testBit (ecx cpuid_01) 20+bSSSE3 = testBit (ecx cpuid_01) 9+bVAES = testBit (ecx cpuid_07_0) 9+bVPCLMULQDQ = testBit (ecx cpuid_07_0) 10++#else++{-# INLINE bAESNI #-}+bAESNI = False++{-# INLINE bAMX_BF16 #-}+bAMX_BF16 = False++{-# INLINE bAMX_FP16 #-}+bAMX_FP16 = False++{-# INLINE bAMX_INT8 #-}+bAMX_INT8 = False++{-# INLINE bAMX_TILE #-}+bAMX_TILE = False++{-# INLINE bAVX #-}+bAVX = False++{-# INLINE bAVX_VNNI #-}+bAVX_VNNI = False++{-# INLINE bAVX10_1 #-}+bAVX10_1 = False++{-# INLINE bAVX10_2 #-}+bAVX10_2 = False++{-# INLINE bAVX2 #-}+bAVX2 = False++{-# INLINE bAVX512_BF16 #-}+bAVX512_BF16 = False++{-# INLINE bAVX512_BITALG #-}+bAVX512_BITALG = False++{-# INLINE bAVX512_FP16 #-}+bAVX512_FP16 = False++{-# INLINE bAVX512_IFMA #-}+bAVX512_IFMA = False++{-# INLINE bAVX512_VBMI #-}+bAVX512_VBMI = False++{-# INLINE bAVX512_VBMI2 #-}+bAVX512_VBMI2 = False++{-# INLINE bAVX512_VNNI #-}+bAVX512_VNNI = False++{-# INLINE bAVX512_VPOPCNTDQ #-}+bAVX512_VPOPCNTDQ = False++{-# INLINE bAVX512BW #-}+bAVX512BW = False++{-# INLINE bAVX512CD #-}+bAVX512CD = False++{-# INLINE bAVX512DQ #-}+bAVX512DQ = False++{-# INLINE bAVX512F #-}+bAVX512F = False++{-# INLINE bAVX512VL #-}+bAVX512VL = False++{-# INLINE bBMI1 #-}+bBMI1 = False++{-# INLINE bBMI2 #-}+bBMI2 = False++{-# INLINE bF16C #-}+bF16C = False++{-# INLINE bFMA #-}+bFMA = False++{-# INLINE bGFNI #-}+bGFNI = False++{-# INLINE bPCLMULQDQ #-}+bPCLMULQDQ = False++{-# INLINE bPOPCNT #-}+bPOPCNT = False++{-# INLINE bRDRAND #-}+bRDRAND = False++{-# INLINE bSHA #-}+bSHA = False++{-# INLINE bSSE3 #-}+bSSE3 = False++{-# INLINE bSSE4_1 #-}+bSSE4_1 = False++{-# INLINE bSSE4_2 #-}+bSSE4_2 = False++{-# INLINE bSSSE3 #-}+bSSSE3 = False++{-# INLINE bVAES #-}+bVAES = False++{-# INLINE bVPCLMULQDQ #-}+bVPCLMULQDQ = False++{-# INLINE mAVX10 #-}+mAVX10 = Nothing++#endif

+ src/System/CPUFeatures/X86/Constraint.hs view

@@ -0,0 +1,60 @@+{- |+Description: x86 features as nullary constraints++This module provides the constraint interface to detect CPU features.+You can mark your function with @Has\<FEATURE NAME\> =>@ to indicate that+it requires a specific CPU feature.+You can detect the availability and get the constraint @Has\<FEATURE NAME\>@+by pattern-matching on the variable @query\<FEATURE NAME\>@.++Example:++> -- This function requires AVX2+> someFunction :: HasAVX2 => ...+>+> case queryAVX2 of+>   Just Dict -> {- In this branch, HasAVX2 is available -} someFunction+>   Nothing -> {- In this branch, HasAVX2 is not available -} error "AVX2 not available"+-}+module System.CPUFeatures.X86.Constraint+  (HasAESNI, queryAESNI+  ,HasAMX_BF16, queryAMX_BF16+  ,HasAMX_FP16, queryAMX_FP16+  ,HasAMX_INT8, queryAMX_INT8+  ,HasAMX_TILE, queryAMX_TILE+  ,HasAVX, queryAVX+  ,HasAVX_VNNI, queryAVX_VNNI+  ,HasAVX10_1, queryAVX10_1+  ,HasAVX10_2, queryAVX10_2+  ,HasAVX2, queryAVX2+  ,HasAVX512_BF16, queryAVX512_BF16+  ,HasAVX512_BITALG, queryAVX512_BITALG+  ,HasAVX512_FP16, queryAVX512_FP16+  ,HasAVX512_IFMA, queryAVX512_IFMA+  ,HasAVX512_VBMI, queryAVX512_VBMI+  ,HasAVX512_VBMI2, queryAVX512_VBMI2+  ,HasAVX512_VNNI, queryAVX512_VNNI+  ,HasAVX512_VPOPCNTDQ, queryAVX512_VPOPCNTDQ+  ,HasAVX512BW, queryAVX512BW+  ,HasAVX512CD, queryAVX512CD+  ,HasAVX512DQ, queryAVX512DQ+  ,HasAVX512F, queryAVX512F+  ,HasAVX512VL, queryAVX512VL+  ,HasBMI1, queryBMI1+  ,HasBMI2, queryBMI2+  ,HasF16C, queryF16C+  ,HasFMA, queryFMA+  ,HasGFNI, queryGFNI+  ,HasPCLMULQDQ, queryPCLMULQDQ+  ,HasPOPCNT, queryPOPCNT+  ,HasRDRAND, queryRDRAND+  ,HasSHA, querySHA+  ,HasSSE3, querySSE3+  ,HasSSE4_1, querySSE4_1+  ,HasSSE4_2, querySSE4_2+  ,HasSSSE3, querySSSE3+  ,HasVAES, queryVAES+  ,HasVPCLMULQDQ, queryVPCLMULQDQ+  ,Dict(Dict)+  ) where+import System.CPUFeatures.X86.Constraint.Unsafe

+ src/System/CPUFeatures/X86/Constraint/Unsafe.hs view

@@ -0,0 +1,391 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module System.CPUFeatures.X86.Constraint.Unsafe+  ( module System.CPUFeatures.X86.Constraint.Unsafe+  , Dict (Dict)+  ) where+import Data.Type.Equality ((:~:)(Refl))+import System.CPUFeatures.Util+import System.CPUFeatures.X86.TypeBool+import Unsafe.Coerce (unsafeCoerce)++class AESNI ~ True => HasAESNI+instance AESNI ~ True => HasAESNI++class BMI1 ~ True => HasBMI1+instance BMI1 ~ True => HasBMI1++class BMI2 ~ True => HasBMI2+instance BMI2 ~ True => HasBMI2++class GFNI ~ True => HasGFNI+instance GFNI ~ True => HasGFNI++class PCLMULQDQ ~ True => HasPCLMULQDQ+instance PCLMULQDQ ~ True => HasPCLMULQDQ++class POPCNT ~ True => HasPOPCNT+instance POPCNT ~ True => HasPOPCNT++class RDRAND ~ True => HasRDRAND+instance RDRAND ~ True => HasRDRAND++class SHA ~ True => HasSHA+instance SHA ~ True => HasSHA++class SSE3 ~ True => HasSSE3+instance SSE3 ~ True => HasSSE3++class (SSSE3 ~ True, HasSSE3) => HasSSSE3+instance (SSSE3 ~ True, HasSSE3) => HasSSSE3++class (SSE4_1 ~ True, HasSSSE3) => HasSSE4_1+instance (SSE4_1 ~ True, HasSSSE3) => HasSSE4_1++class (SSE4_2 ~ True, HasSSE4_1) => HasSSE4_2+instance (SSE4_2 ~ True, HasSSE4_1) => HasSSE4_2++class (AVX ~ True, HasSSE4_2) => HasAVX+instance (AVX ~ True, HasSSE4_2) => HasAVX++class (AVX2 ~ True, HasAVX) => HasAVX2+instance (AVX2 ~ True, HasAVX) => HasAVX2++class (F16C ~ True, HasAVX) => HasF16C+instance (F16C ~ True, HasAVX) => HasF16C++class (FMA ~ True, HasAVX) => HasFMA+instance (FMA ~ True, HasAVX) => HasFMA++class (AVX_VNNI ~ True, HasAVX2) => HasAVX_VNNI+instance (AVX_VNNI ~ True, HasAVX2) => HasAVX_VNNI++class (AVX512F ~ True, HasAVX2, HasF16C, HasFMA) => HasAVX512F+instance (AVX512F ~ True, HasAVX2, HasF16C, HasFMA) => HasAVX512F++class (AVX512VL ~ True, HasAVX512F) => HasAVX512VL+instance (AVX512VL ~ True, HasAVX512F) => HasAVX512VL++class (AVX512BW ~ True, HasAVX512F) => HasAVX512BW+instance (AVX512BW ~ True, HasAVX512F) => HasAVX512BW++class (AVX512DQ ~ True, HasAVX512F) => HasAVX512DQ+instance (AVX512DQ ~ True, HasAVX512F) => HasAVX512DQ++class (AVX512CD ~ True, HasAVX512F) => HasAVX512CD+instance (AVX512CD ~ True, HasAVX512F) => HasAVX512CD++class (AVX512_BF16 ~ True, HasAVX512BW) => HasAVX512_BF16+instance (AVX512_BF16 ~ True, HasAVX512BW) => HasAVX512_BF16++class (AVX512_BITALG ~ True, HasAVX512BW) => HasAVX512_BITALG+instance (AVX512_BITALG ~ True, HasAVX512BW) => HasAVX512_BITALG++class (AVX512_FP16 ~ True, HasAVX512BW) => HasAVX512_FP16+instance (AVX512_FP16 ~ True, HasAVX512BW) => HasAVX512_FP16++class (AVX512_IFMA ~ True, HasAVX512F) => HasAVX512_IFMA+instance (AVX512_IFMA ~ True, HasAVX512F) => HasAVX512_IFMA++class (AVX512_VBMI ~ True, HasAVX512BW) => HasAVX512_VBMI+instance (AVX512_VBMI ~ True, HasAVX512BW) => HasAVX512_VBMI++class (AVX512_VBMI2 ~ True, HasAVX512BW) => HasAVX512_VBMI2+instance (AVX512_VBMI2 ~ True, HasAVX512BW) => HasAVX512_VBMI2++class (AVX512_VNNI ~ True, HasAVX512F) => HasAVX512_VNNI+instance (AVX512_VNNI ~ True, HasAVX512F) => HasAVX512_VNNI++class (AVX512_VPOPCNTDQ ~ True, HasAVX512F) => HasAVX512_VPOPCNTDQ+instance (AVX512_VPOPCNTDQ ~ True, HasAVX512F) => HasAVX512_VPOPCNTDQ++class (AVX10_1 ~ True, HasAVX2, HasF16C, HasFMA) => HasAVX10_1+instance (AVX10_1 ~ True, HasAVX2, HasF16C, HasFMA) => HasAVX10_1++class (AVX10_2 ~ True, HasAVX10_1) => HasAVX10_2+instance (AVX10_2 ~ True, HasAVX10_1) => HasAVX10_2++class (VAES ~ True, HasAVX2, HasAESNI) => HasVAES+instance (VAES ~ True, HasAVX2, HasAESNI) => HasVAES++class (VPCLMULQDQ ~ True, HasAVX, HasPCLMULQDQ) => HasVPCLMULQDQ+instance (VPCLMULQDQ ~ True, HasAVX, HasPCLMULQDQ) => HasVPCLMULQDQ++class AMX_TILE ~ True => HasAMX_TILE+instance AMX_TILE ~ True => HasAMX_TILE++class (AMX_BF16 ~ True, HasAMX_TILE) => HasAMX_BF16+instance (AMX_BF16 ~ True, HasAMX_TILE) => HasAMX_BF16++class (AMX_FP16 ~ True, HasAMX_TILE) => HasAMX_FP16+instance (AMX_FP16 ~ True, HasAMX_TILE) => HasAMX_FP16++class (AMX_INT8 ~ True, HasAMX_TILE) => HasAMX_INT8+instance (AMX_INT8 ~ True, HasAMX_TILE) => HasAMX_INT8++unsafeAssumeAESNI :: (HasAESNI => a) -> a+unsafeAssumeAESNI k = case unsafeCoerce Refl :: AESNI :~: True of Refl -> k++queryAESNI :: Maybe (Dict HasAESNI)+queryAESNI = case sAESNI of STrue -> unsafeAssumeAESNI (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAESNI #-}++unsafeAssumeBMI1 :: (HasBMI1 => a) -> a+unsafeAssumeBMI1 k = case unsafeCoerce Refl :: BMI1 :~: True of Refl -> k++queryBMI1 :: Maybe (Dict HasBMI1)+queryBMI1 = case sBMI1 of STrue -> unsafeAssumeBMI1 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryBMI1 #-}++unsafeAssumeBMI2 :: (HasBMI2 => a) -> a+unsafeAssumeBMI2 k = case unsafeCoerce Refl :: BMI2 :~: True of Refl -> k++queryBMI2 :: Maybe (Dict HasBMI2)+queryBMI2 = case sBMI2 of STrue -> unsafeAssumeBMI2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryBMI2 #-}++unsafeAssumeGFNI :: (HasGFNI => a) -> a+unsafeAssumeGFNI k = case unsafeCoerce Refl :: GFNI :~: True of Refl -> k++queryGFNI :: Maybe (Dict HasGFNI)+queryGFNI = case sGFNI of STrue -> unsafeAssumeGFNI (Just Dict); SFalse -> Nothing+{-# NOINLINE queryGFNI #-}++unsafeAssumePCLMULQDQ :: (HasPCLMULQDQ => a) -> a+unsafeAssumePCLMULQDQ k = case unsafeCoerce Refl :: PCLMULQDQ :~: True of Refl -> k++queryPCLMULQDQ :: Maybe (Dict HasPCLMULQDQ)+queryPCLMULQDQ = case sPCLMULQDQ of STrue -> unsafeAssumePCLMULQDQ (Just Dict); SFalse -> Nothing+{-# NOINLINE queryPCLMULQDQ #-}++unsafeAssumePOPCNT :: (HasPOPCNT => a) -> a+unsafeAssumePOPCNT k = case unsafeCoerce Refl :: POPCNT :~: True of Refl -> k++queryPOPCNT :: Maybe (Dict HasPOPCNT)+queryPOPCNT = case sPOPCNT of STrue -> unsafeAssumePOPCNT (Just Dict); SFalse -> Nothing+{-# NOINLINE queryPOPCNT #-}++unsafeAssumeRDRAND :: (HasRDRAND => a) -> a+unsafeAssumeRDRAND k = case unsafeCoerce Refl :: RDRAND :~: True of Refl -> k++queryRDRAND :: Maybe (Dict HasRDRAND)+queryRDRAND = case sRDRAND of STrue -> unsafeAssumeRDRAND (Just Dict); SFalse -> Nothing+{-# NOINLINE queryRDRAND #-}++unsafeAssumeSHA :: (HasSHA => a) -> a+unsafeAssumeSHA k = case unsafeCoerce Refl :: SHA :~: True of Refl -> k++querySHA :: Maybe (Dict HasSHA)+querySHA = case sSHA of STrue -> unsafeAssumeSHA (Just Dict); SFalse -> Nothing+{-# NOINLINE querySHA #-}++unsafeAssumeSSE3 :: (HasSSE3 => a) -> a+unsafeAssumeSSE3 k = case unsafeCoerce Refl :: SSE3 :~: True of Refl -> k++querySSE3 :: Maybe (Dict HasSSE3)+querySSE3 = case sSSE3 of STrue -> unsafeAssumeSSE3 (Just Dict); SFalse -> Nothing+{-# NOINLINE querySSE3 #-}++unsafeAssumeSSSE3 :: (HasSSSE3 => a) -> a+unsafeAssumeSSSE3 k = case unsafeCoerce Refl :: SSSE3 :~: True of Refl -> unsafeAssumeSSE3 k++querySSSE3 :: Maybe (Dict HasSSSE3)+querySSSE3 = case sSSSE3 of STrue -> unsafeAssumeSSSE3 (Just Dict); SFalse -> Nothing+{-# NOINLINE querySSSE3 #-}++unsafeAssumeSSE4_1 :: (HasSSE4_1 => a) -> a+unsafeAssumeSSE4_1 k = case unsafeCoerce Refl :: SSE4_1 :~: True of Refl -> unsafeAssumeSSSE3 k++querySSE4_1 :: Maybe (Dict HasSSE4_1)+querySSE4_1 = case sSSE4_1 of STrue -> unsafeAssumeSSE4_1 (Just Dict); SFalse -> Nothing+{-# NOINLINE querySSE4_1 #-}++unsafeAssumeSSE4_2 :: (HasSSE4_2 => a) -> a+unsafeAssumeSSE4_2 k = case unsafeCoerce Refl :: SSE4_2 :~: True of Refl -> unsafeAssumeSSE4_1 k++querySSE4_2 :: Maybe (Dict HasSSE4_2)+querySSE4_2 = case sSSE4_2 of STrue -> unsafeAssumeSSE4_2 (Just Dict); SFalse -> Nothing+{-# NOINLINE querySSE4_2 #-}++unsafeAssumeAVX :: (HasAVX => a) -> a+unsafeAssumeAVX k = case unsafeCoerce Refl :: AVX :~: True of Refl -> unsafeAssumeSSE4_2 k++queryAVX :: Maybe (Dict HasAVX)+queryAVX = case sAVX of STrue -> unsafeAssumeAVX (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX #-}++unsafeAssumeAVX2 :: (HasAVX2 => a) -> a+unsafeAssumeAVX2 k = case unsafeCoerce Refl :: AVX2 :~: True of Refl -> unsafeAssumeAVX k++queryAVX2 :: Maybe (Dict HasAVX2)+queryAVX2 = case sAVX2 of STrue -> unsafeAssumeAVX2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX2 #-}++unsafeAssumeF16C :: (HasF16C => a) -> a+unsafeAssumeF16C k = case unsafeCoerce Refl :: F16C :~: True of Refl -> unsafeAssumeAVX k++queryF16C :: Maybe (Dict HasF16C)+queryF16C = case sF16C of STrue -> unsafeAssumeF16C (Just Dict); SFalse -> Nothing+{-# NOINLINE queryF16C #-}++unsafeAssumeFMA :: (HasFMA => a) -> a+unsafeAssumeFMA k = case unsafeCoerce Refl :: FMA :~: True of Refl -> unsafeAssumeAVX k++queryFMA :: Maybe (Dict HasFMA)+queryFMA = case sFMA of STrue -> unsafeAssumeFMA (Just Dict); SFalse -> Nothing+{-# NOINLINE queryFMA #-}++unsafeAssumeAVX_VNNI :: (HasAVX_VNNI => a) -> a+unsafeAssumeAVX_VNNI k = case unsafeCoerce Refl :: AVX_VNNI :~: True of Refl -> unsafeAssumeAVX2 k++queryAVX_VNNI :: Maybe (Dict HasAVX_VNNI)+queryAVX_VNNI = case sAVX_VNNI of STrue -> unsafeAssumeAVX_VNNI (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX_VNNI #-}++unsafeAssumeAVX512F :: (HasAVX512F => a) -> a+unsafeAssumeAVX512F k = case unsafeCoerce Refl :: AVX512F :~: True of Refl -> unsafeAssumeFMA (unsafeAssumeF16C (unsafeAssumeAVX2 k))++queryAVX512F :: Maybe (Dict HasAVX512F)+queryAVX512F = case sAVX512F of STrue -> unsafeAssumeAVX512F (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512F #-}++unsafeAssumeAVX512VL :: (HasAVX512VL => a) -> a+unsafeAssumeAVX512VL k = case unsafeCoerce Refl :: AVX512VL :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512VL :: Maybe (Dict HasAVX512VL)+queryAVX512VL = case sAVX512VL of STrue -> unsafeAssumeAVX512VL (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512VL #-}++unsafeAssumeAVX512BW :: (HasAVX512BW => a) -> a+unsafeAssumeAVX512BW k = case unsafeCoerce Refl :: AVX512BW :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512BW :: Maybe (Dict HasAVX512BW)+queryAVX512BW = case sAVX512BW of STrue -> unsafeAssumeAVX512BW (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512BW #-}++unsafeAssumeAVX512DQ :: (HasAVX512DQ => a) -> a+unsafeAssumeAVX512DQ k = case unsafeCoerce Refl :: AVX512DQ :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512DQ :: Maybe (Dict HasAVX512DQ)+queryAVX512DQ = case sAVX512DQ of STrue -> unsafeAssumeAVX512DQ (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512DQ #-}++unsafeAssumeAVX512CD :: (HasAVX512CD => a) -> a+unsafeAssumeAVX512CD k = case unsafeCoerce Refl :: AVX512CD :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512CD :: Maybe (Dict HasAVX512CD)+queryAVX512CD = case sAVX512CD of STrue -> unsafeAssumeAVX512CD (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512CD #-}++unsafeAssumeAVX512_BF16 :: (HasAVX512_BF16 => a) -> a+unsafeAssumeAVX512_BF16 k = case unsafeCoerce Refl :: AVX512_BF16 :~: True of Refl -> unsafeAssumeAVX512BW k++queryAVX512_BF16 :: Maybe (Dict HasAVX512_BF16)+queryAVX512_BF16 = case sAVX512_BF16 of STrue -> unsafeAssumeAVX512_BF16 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_BF16 #-}++unsafeAssumeAVX512_BITALG :: (HasAVX512_BITALG => a) -> a+unsafeAssumeAVX512_BITALG k = case unsafeCoerce Refl :: AVX512_BITALG :~: True of Refl -> unsafeAssumeAVX512BW k++queryAVX512_BITALG :: Maybe (Dict HasAVX512_BITALG)+queryAVX512_BITALG = case sAVX512_BITALG of STrue -> unsafeAssumeAVX512_BITALG (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_BITALG #-}++unsafeAssumeAVX512_FP16 :: (HasAVX512_FP16 => a) -> a+unsafeAssumeAVX512_FP16 k = case unsafeCoerce Refl :: AVX512_FP16 :~: True of Refl -> unsafeAssumeAVX512BW k++queryAVX512_FP16 :: Maybe (Dict HasAVX512_FP16)+queryAVX512_FP16 = case sAVX512_FP16 of STrue -> unsafeAssumeAVX512_FP16 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_FP16 #-}++unsafeAssumeAVX512_IFMA :: (HasAVX512_IFMA => a) -> a+unsafeAssumeAVX512_IFMA k = case unsafeCoerce Refl :: AVX512_IFMA :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512_IFMA :: Maybe (Dict HasAVX512_IFMA)+queryAVX512_IFMA = case sAVX512_IFMA of STrue -> unsafeAssumeAVX512_IFMA (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_IFMA #-}++unsafeAssumeAVX512_VBMI :: (HasAVX512_VBMI => a) -> a+unsafeAssumeAVX512_VBMI k = case unsafeCoerce Refl :: AVX512_VBMI :~: True of Refl -> unsafeAssumeAVX512BW k++queryAVX512_VBMI :: Maybe (Dict HasAVX512_VBMI)+queryAVX512_VBMI = case sAVX512_VBMI of STrue -> unsafeAssumeAVX512_VBMI (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_VBMI #-}++unsafeAssumeAVX512_VBMI2 :: (HasAVX512_VBMI2 => a) -> a+unsafeAssumeAVX512_VBMI2 k = case unsafeCoerce Refl :: AVX512_VBMI2 :~: True of Refl -> unsafeAssumeAVX512BW k++queryAVX512_VBMI2 :: Maybe (Dict HasAVX512_VBMI2)+queryAVX512_VBMI2 = case sAVX512_VBMI2 of STrue -> unsafeAssumeAVX512_VBMI2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_VBMI2 #-}++unsafeAssumeAVX512_VNNI :: (HasAVX512_VNNI => a) -> a+unsafeAssumeAVX512_VNNI k = case unsafeCoerce Refl :: AVX512_VNNI :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512_VNNI :: Maybe (Dict HasAVX512_VNNI)+queryAVX512_VNNI = case sAVX512_VNNI of STrue -> unsafeAssumeAVX512_VNNI (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_VNNI #-}++unsafeAssumeAVX512_VPOPCNTDQ :: (HasAVX512_VPOPCNTDQ => a) -> a+unsafeAssumeAVX512_VPOPCNTDQ k = case unsafeCoerce Refl :: AVX512_VPOPCNTDQ :~: True of Refl -> unsafeAssumeAVX512F k++queryAVX512_VPOPCNTDQ :: Maybe (Dict HasAVX512_VPOPCNTDQ)+queryAVX512_VPOPCNTDQ = case sAVX512_VPOPCNTDQ of STrue -> unsafeAssumeAVX512_VPOPCNTDQ (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX512_VPOPCNTDQ #-}++unsafeAssumeAVX10_1 :: (HasAVX10_1 => a) -> a+unsafeAssumeAVX10_1 k = case unsafeCoerce Refl :: AVX10_1 :~: True of Refl -> unsafeAssumeFMA (unsafeAssumeF16C (unsafeAssumeAVX2 k))++queryAVX10_1 :: Maybe (Dict HasAVX10_1)+queryAVX10_1 = case sAVX10_1 of STrue -> unsafeAssumeAVX10_1 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX10_1 #-}++unsafeAssumeAVX10_2 :: (HasAVX10_2 => a) -> a+unsafeAssumeAVX10_2 k = case unsafeCoerce Refl :: AVX10_2 :~: True of Refl -> unsafeAssumeAVX10_1 k++queryAVX10_2 :: Maybe (Dict HasAVX10_2)+queryAVX10_2 = case sAVX10_2 of STrue -> unsafeAssumeAVX10_2 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAVX10_2 #-}++unsafeAssumeVAES :: (HasVAES => a) -> a+unsafeAssumeVAES k = case unsafeCoerce Refl :: VAES :~: True of Refl -> unsafeAssumeAESNI (unsafeAssumeAVX2 k)++queryVAES :: Maybe (Dict HasVAES)+queryVAES = case sVAES of STrue -> unsafeAssumeVAES (Just Dict); SFalse -> Nothing+{-# NOINLINE queryVAES #-}++unsafeAssumeVPCLMULQDQ :: (HasVPCLMULQDQ => a) -> a+unsafeAssumeVPCLMULQDQ k = case unsafeCoerce Refl :: VPCLMULQDQ :~: True of Refl -> unsafeAssumePCLMULQDQ (unsafeAssumeAVX k)++queryVPCLMULQDQ :: Maybe (Dict HasVPCLMULQDQ)+queryVPCLMULQDQ = case sVPCLMULQDQ of STrue -> unsafeAssumeVPCLMULQDQ (Just Dict); SFalse -> Nothing+{-# NOINLINE queryVPCLMULQDQ #-}++unsafeAssumeAMX_TILE :: (HasAMX_TILE => a) -> a+unsafeAssumeAMX_TILE k = case unsafeCoerce Refl :: AMX_TILE :~: True of Refl -> k++queryAMX_TILE :: Maybe (Dict HasAMX_TILE)+queryAMX_TILE = case sAMX_TILE of STrue -> unsafeAssumeAMX_TILE (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAMX_TILE #-}++unsafeAssumeAMX_BF16 :: (HasAMX_BF16 => a) -> a+unsafeAssumeAMX_BF16 k = case unsafeCoerce Refl :: AMX_BF16 :~: True of Refl -> unsafeAssumeAMX_TILE k++queryAMX_BF16 :: Maybe (Dict HasAMX_BF16)+queryAMX_BF16 = case sAMX_BF16 of STrue -> unsafeAssumeAMX_BF16 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAMX_BF16 #-}++unsafeAssumeAMX_FP16 :: (HasAMX_FP16 => a) -> a+unsafeAssumeAMX_FP16 k = case unsafeCoerce Refl :: AMX_FP16 :~: True of Refl -> unsafeAssumeAMX_TILE k++queryAMX_FP16 :: Maybe (Dict HasAMX_FP16)+queryAMX_FP16 = case sAMX_FP16 of STrue -> unsafeAssumeAMX_FP16 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAMX_FP16 #-}++unsafeAssumeAMX_INT8 :: (HasAMX_INT8 => a) -> a+unsafeAssumeAMX_INT8 k = case unsafeCoerce Refl :: AMX_INT8 :~: True of Refl -> unsafeAssumeAMX_TILE k++queryAMX_INT8 :: Maybe (Dict HasAMX_INT8)+queryAMX_INT8 = case sAMX_INT8 of STrue -> unsafeAssumeAMX_INT8 (Just Dict); SFalse -> Nothing+{-# NOINLINE queryAMX_INT8 #-}

+ src/System/CPUFeatures/X86/Cpuid.hs view

@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MonoLocalBinds #-}+module System.CPUFeatures.X86.Cpuid+  ( CpuidResult(..)+  , X86Cpuid(..)+  , queryCpuid+  , getManufacturerString+  , Dict(Dict)+  ) where+import Data.Word+import System.CPUFeatures.Util+#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)+import Data.Bits+import Data.Char (chr)+import System.IO.Unsafe+import Foreign.Marshal.Alloc+import Foreign.Storable+import Foreign.Ptr+#endif++data CpuidResult = CpuidResult { eax :: !Word32, ebx :: !Word32, ecx :: !Word32, edx :: !Word32 } deriving Show++class X86Cpuid where+  cpuid :: Word32 -- ^ Initial eax value (leaf / function)+        -> Word32 -- ^ Initial ecx value (subleaf / subfunction)+        -> CpuidResult+  xgetbv :: Word32 -> Word64++queryCpuid :: Maybe (Dict X86Cpuid)++getManufacturerString :: X86Cpuid => String++#if defined(x86_64_HOST_ARCH) || defined(i386_HOST_ARCH)++foreign import ccall unsafe hs_cpu_features_cpuid :: Word32 -> Word32 -> Ptr Word32 -> IO ()++foreign import ccall unsafe hs_cpu_features_xgetbv :: Word32 -> Word64++instance X86Cpuid where+  cpuid !initialEax !initialEcx = unsafePerformIO $ allocaBytes (4 * 4) $ \ptr -> do+    hs_cpu_features_cpuid initialEax initialEcx ptr+    a <- peek ptr+    b <- peekElemOff ptr 1+    c <- peekElemOff ptr 2+    d <- peekElemOff ptr 3+    pure $ CpuidResult a b c d+  xgetbv = hs_cpu_features_xgetbv++queryCpuid = Just Dict++getManufacturerString = case cpuid 0 0 of+  CpuidResult _ b c d -> wordToChars b $ wordToChars d $ wordToChars c ""+  where+    bchr = chr . fromIntegral+    wordToChars x s = bchr (fromIntegral $ x .&. 0xFF) : bchr ((x `unsafeShiftR` 8) .&. 0xFF) : bchr ((x `unsafeShiftR` 16) .&. 0xFF) : bchr ((x `unsafeShiftR` 24) .&. 0xFF) : s++#else++queryCpuid = Nothing+getManufacturerString = undefined++#endif

+ src/System/CPUFeatures/X86/TypeBool.hs view

@@ -0,0 +1,180 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{- |+Description: x86 features as type-level booleans++This module provides the type-level interface to detect CPU features.+You can mark your function with @\<FEATURE NAME\> ~ True =>@ to indicate that+it requires a specific CPU feature.+You can detect the availability and get the constraint @\<FEATURE NAME\> ~ True@+by pattern-matching on the variable @s\<FEATURE NAME\>@.++Example:++> -- This function requires AVX2+> someFunction :: AVX2 ~ True => ...+>+> case sAVX2 of+>   STrue -> {- In this branch, AVX2 is True -} someFunction+>   SFalse -> {- In this branch, AVX2 is False -} error "AVX2 not available"+-}+module System.CPUFeatures.X86.TypeBool+  (AESNI, sAESNI+  ,AMX_BF16, sAMX_BF16+  ,AMX_FP16, sAMX_FP16+  ,AMX_INT8, sAMX_INT8+  ,AMX_TILE, sAMX_TILE+  ,AVX, sAVX+  ,AVX_VNNI, sAVX_VNNI+  ,AVX10_1, sAVX10_1+  ,AVX10_2, sAVX10_2+  ,AVX2, sAVX2+  ,AVX512_BF16, sAVX512_BF16+  ,AVX512_BITALG, sAVX512_BITALG+  ,AVX512_FP16, sAVX512_FP16+  ,AVX512_IFMA, sAVX512_IFMA+  ,AVX512_VBMI, sAVX512_VBMI+  ,AVX512_VBMI2, sAVX512_VBMI2+  ,AVX512_VNNI, sAVX512_VNNI+  ,AVX512_VPOPCNTDQ, sAVX512_VPOPCNTDQ+  ,AVX512BW, sAVX512BW+  ,AVX512CD, sAVX512CD+  ,AVX512DQ, sAVX512DQ+  ,AVX512F, sAVX512F+  ,AVX512VL, sAVX512VL+  ,BMI1, sBMI1+  ,BMI2, sBMI2+  ,F16C, sF16C+  ,FMA, sFMA+  ,GFNI, sGFNI+  ,PCLMULQDQ, sPCLMULQDQ+  ,POPCNT, sPOPCNT+  ,RDRAND, sRDRAND+  ,SHA, sSHA+  ,SSE3, sSSE3+  ,SSE4_1, sSSE4_1+  ,SSE4_2, sSSE4_2+  ,SSSE3, sSSSE3+  ,VAES, sVAES+  ,VPCLMULQDQ, sVPCLMULQDQ+  ,SBool(..)+  ) where+import System.CPUFeatures.X86.Bool+import System.CPUFeatures.Util++type family AESNI :: Bool+type family AMX_BF16 :: Bool+type family AMX_FP16 :: Bool+type family AMX_INT8 :: Bool+type family AMX_TILE :: Bool+type family AVX :: Bool+type family AVX_VNNI :: Bool+type family AVX10_1 :: Bool+type family AVX10_2 :: Bool+type family AVX2 :: Bool+type family AVX512_BF16 :: Bool+type family AVX512_BITALG :: Bool+type family AVX512_FP16 :: Bool+type family AVX512_IFMA :: Bool+type family AVX512_VBMI :: Bool+type family AVX512_VBMI2 :: Bool+type family AVX512_VNNI :: Bool+type family AVX512_VPOPCNTDQ :: Bool+type family AVX512BW :: Bool+type family AVX512CD :: Bool+type family AVX512DQ :: Bool+type family AVX512F :: Bool+type family AVX512VL :: Bool+type family BMI1 :: Bool+type family BMI2 :: Bool+type family F16C :: Bool+type family FMA :: Bool+type family GFNI :: Bool+type family PCLMULQDQ :: Bool+type family POPCNT :: Bool+type family RDRAND :: Bool+type family SHA :: Bool+type family SSE3 :: Bool+type family SSE4_1 :: Bool+type family SSE4_2 :: Bool+type family SSSE3 :: Bool+type family VAES :: Bool+type family VPCLMULQDQ :: Bool++sAESNI :: SBool AESNI+sAMX_BF16 :: SBool AMX_BF16+sAMX_FP16 :: SBool AMX_FP16+sAMX_INT8 :: SBool AMX_INT8+sAMX_TILE :: SBool AMX_TILE+sAVX :: SBool AVX+sAVX_VNNI :: SBool AVX_VNNI+sAVX10_1 :: SBool AVX10_1+sAVX10_2 :: SBool AVX10_2+sAVX2 :: SBool AVX2+sAVX512_BF16 :: SBool AVX512_BF16+sAVX512_BITALG :: SBool AVX512_BITALG+sAVX512_FP16 :: SBool AVX512_FP16+sAVX512_IFMA :: SBool AVX512_IFMA+sAVX512_VBMI :: SBool AVX512_VBMI+sAVX512_VBMI2 :: SBool AVX512_VBMI2+sAVX512_VNNI :: SBool AVX512_VNNI+sAVX512_VPOPCNTDQ :: SBool AVX512_VPOPCNTDQ+sAVX512BW :: SBool AVX512BW+sAVX512CD :: SBool AVX512CD+sAVX512DQ :: SBool AVX512DQ+sAVX512F :: SBool AVX512F+sAVX512VL :: SBool AVX512VL+sBMI1 :: SBool BMI1+sBMI2 :: SBool BMI2+sF16C :: SBool F16C+sFMA :: SBool FMA+sGFNI :: SBool GFNI+sPCLMULQDQ :: SBool PCLMULQDQ+sPOPCNT :: SBool POPCNT+sRDRAND :: SBool RDRAND+sSHA :: SBool SHA+sSSE3 :: SBool SSE3+sSSE4_1 :: SBool SSE4_1+sSSE4_2 :: SBool SSE4_2+sSSSE3 :: SBool SSSE3+sVAES :: SBool VAES+sVPCLMULQDQ :: SBool VPCLMULQDQ++sAESNI = unsafeBoolToSBool bAESNI+sAMX_BF16 = unsafeBoolToSBool bAMX_BF16+sAMX_FP16 = unsafeBoolToSBool bAMX_FP16+sAMX_INT8 = unsafeBoolToSBool bAMX_INT8+sAMX_TILE = unsafeBoolToSBool bAMX_TILE+sAVX = unsafeBoolToSBool bAVX+sAVX_VNNI = unsafeBoolToSBool bAVX_VNNI+sAVX10_1 = unsafeBoolToSBool bAVX10_1+sAVX10_2 = unsafeBoolToSBool bAVX10_2+sAVX2 = unsafeBoolToSBool bAVX2+sAVX512_BF16 = unsafeBoolToSBool bAVX512_BF16+sAVX512_BITALG = unsafeBoolToSBool bAVX512_BITALG+sAVX512_FP16 = unsafeBoolToSBool bAVX512_FP16+sAVX512_IFMA = unsafeBoolToSBool bAVX512_IFMA+sAVX512_VBMI = unsafeBoolToSBool bAVX512_VBMI+sAVX512_VBMI2 = unsafeBoolToSBool bAVX512_VBMI2+sAVX512_VNNI = unsafeBoolToSBool bAVX512_VNNI+sAVX512_VPOPCNTDQ = unsafeBoolToSBool bAVX512_VPOPCNTDQ+sAVX512BW = unsafeBoolToSBool bAVX512BW+sAVX512CD = unsafeBoolToSBool bAVX512CD+sAVX512DQ = unsafeBoolToSBool bAVX512DQ+sAVX512F = unsafeBoolToSBool bAVX512F+sAVX512VL = unsafeBoolToSBool bAVX512VL+sBMI1 = unsafeBoolToSBool bBMI1+sBMI2 = unsafeBoolToSBool bBMI2+sF16C = unsafeBoolToSBool bF16C+sFMA = unsafeBoolToSBool bFMA+sGFNI = unsafeBoolToSBool bGFNI+sPCLMULQDQ = unsafeBoolToSBool bPCLMULQDQ+sPOPCNT = unsafeBoolToSBool bPOPCNT+sRDRAND = unsafeBoolToSBool bRDRAND+sSHA = unsafeBoolToSBool bSHA+sSSE3 = unsafeBoolToSBool bSSE3+sSSE4_1 = unsafeBoolToSBool bSSE4_1+sSSE4_2 = unsafeBoolToSBool bSSE4_2+sSSSE3 = unsafeBoolToSBool bSSSE3+sVAES = unsafeBoolToSBool bVAES+sVPCLMULQDQ = unsafeBoolToSBool bVPCLMULQDQ

+ test/Main.hs view

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."