[bug#64188] [PATCH 2/8] guix: cpu: Add inexact CPU matching.

[Efraim Flashner]

* guix/cpu.scm (cpu->generic-architecture): New variable.
---
 guix/cpu.scm | 36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

diff --git a/guix/cpu.scm b/guix/cpu.scm
index 45e1abeed7..e6102e3d14 100644
--- a/guix/cpu.scm
+++ b/guix/cpu.scm
@@ -32,7 +32,8 @@ (define-module (guix cpu)
             cpu-model
             cpu-flags
 
-            cpu->gcc-architecture))
+            cpu->gcc-architecture
+            cpu->generic-architecture))
 
 ;;; Commentary:
 ;;;
@@ -285,3 +286,36 @@ (define (cpu->gcc-architecture cpu)
     (architecture
      ;; TODO: More architectures
      architecture)))
+
+(define (cpu->generic-architecture cpu)
+  "Return the architecture name, suitable for inexact architecture 
optimizations,
+that corresponds to CPU, a record as returned by 'current-cpu'."
+  (match (cpu-architecture cpu)
+    ("x86_64"
+     (or (letrec-syntax ((if-flags (syntax-rules (=>)
+                                     ((_)
+                                      #f)
+                                     ((_ (flags ... => name) rest ...)
+                                      (if (every (lambda (flag)
+                                                   (set-contains? (cpu-flags 
cpu)
+                                                                  flag))
+                                                 '(flags ...))
+                                        name
+                                        (if-flags rest ...))))))
+
+           (if-flags
+             ;; 
https://gitlab.com/x86-psABIs/x86-64-ABI/-/blob/master/x86-64-ABI/low-level-sys-info.tex
+             ;; v4: AVX512F, AVX512BW, AVX512CD, AVX512DQ, AVX512VL
+             ;; v3: AVX, AVX2, BMI1, BMI2, F16C, FMA, LZCNT, MOVBE, OSXSAVE
+             ;; v2: CMPXCHG16B, LAHF, SAHF, POPCNT, SSE3, SSE4.1, SSE4.2, SSSE3
+             ("avx512f" "avx512bw" "abx512cd" "abx512dq" "avx512vl"
+              "avx" "avx2" "bmi1" "bmi2" "f16c" "fma" "movbe"
+              "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v4")
+             ("avx" "avx2" "bmi1" "bmi2" "f16c" "fma" "movbe"
+              "popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v3")
+             ("popcnt" "sse3" "sse4_1" "sse4_2" "ssse3" => "x86_64-v2")
+             (_ => "x86_64-v1")))
+         "x86_64-v1"))
+    (architecture
+     ;; TODO: More architectures
+     architecture)))
-- 
Efraim Flashner   <efraim@flashner.co.il>   רנשלפ םירפא
GPG key = A28B F40C 3E55 1372 662D  14F7 41AA E7DC CA3D 8351
Confidentiality cannot be guaranteed on emails sent or received unencrypted