From aaf7820d57c6e767892766a9e76077eff9a48e9e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 2 Sep 2022 10:19:48 +0200
Subject: read-print: Improve declaration of integer bases.

This is a followup to c3b1cfe76b7038f4030d7d207ffc417fed9a7ead.

* guix/read-print.scm (%symbols-followed-by-octal-integers)
(%symbols-followed-by-hexadecimal-integers): Remove.
* guix/read-print.scm (%integer-forms): New variable.
(integer->string)[form-base, octal?]: New procedures.
Rewrite accordingly.
---
 guix/read-print.scm | 42 ++++++++++++++++++++++++++++--------------
 1 file changed, 28 insertions(+), 14 deletions(-)

diff --git a/guix/read-print.scm b/guix/read-print.scm
index 6e1188e87e..a5a1b708bf 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -442,26 +442,40 @@ each line except the first one (they're assumed to be already there)."
        (display (make-string indent #\space) port)
        (loop tail)))))
 
-(define %symbols-followed-by-octal-integers
-  ;; Symbols for which the following integer must be printed as octal.
-  '(chmod umask mkdir mkstemp))
-
-(define %symbols-followed-by-hexadecimal-integers
-  ;; Likewise, for hexadecimal integers.
-  '(logand logior logxor lognot))
+(define %integer-forms
+  ;; Forms that take an integer as their argument, where said integer should
+  ;; be printed in base other than decimal base.
+  (letrec-syntax ((vhashq (syntax-rules ()
+                            ((_) vlist-null)
+                            ((_ (key value) rest ...)
+                             (vhash-consq key value (vhashq rest ...))))))
+    (vhashq
+     ('chmod 8)
+     ('umask 8)
+     ('mkdir 8)
+     ('mkstemp 8)
+     ('logand 16)
+     ('logior 16)
+     ('logxor 16)
+     ('lognot 16))))
 
 (define (integer->string integer context)
   "Render INTEGER as a string using a base suitable based on CONTEXT."
+  (define (form-base form)
+    (match (vhash-assq form %integer-forms)
+      (#f 10)
+      ((_ . base) base)))
+
+  (define (octal? form)
+    (= 8 (form-base form)))
+
   (define base
     (match context
       ((head . tail)
-       (cond ((memq head %symbols-followed-by-octal-integers) 8)
-             ((memq head %symbols-followed-by-hexadecimal-integers)
-              (if (any (cut memq <> %symbols-followed-by-octal-integers)
-                       tail)
-                  8
-                  16))
-             (else 10)))
+       (match (form-base head)
+         (8 8)
+         (16 (if (any octal? tail) 8 16))
+         (10 10)))
       (_ 10)))
 
   (string-append (match base
-- 
cgit v1.2.3