summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-01-09 17:04:55 +0100
committerLudovic Courtès <ludo@gnu.org>2023-01-09 17:40:54 +0100
commit6c343d0d0f6b8560e9eb594ce1d4f984753a35fb (patch)
tree380e8d3e757ddd28c8e0213ff94a68931227ffb4
parent407175a1d0e29f45639e7f28a531b3981cd20085 (diff)
downloadguix-6c343d0d0f6b8560e9eb594ce1d4f984753a35fb.tar.gz
read-print: Do not use extended notation when printing '1+', '1-', etc.
* guix/read-print.scm (%special-non-extended-symbols): New variable.
(symbol->display-string): New procedure.
(pretty-print-with-comments): Use it in lieu of 'string->symbol'.
* tests/read-print.scm: Add test.
-rw-r--r--guix/read-print.scm22
-rw-r--r--tests/read-print.scm7
2 files changed, 25 insertions, 4 deletions
diff --git a/guix/read-print.scm b/guix/read-print.scm
index 8a720ef2ef..ccddca732d 100644
--- a/guix/read-print.scm
+++ b/guix/read-print.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -488,6 +488,19 @@ each line except the first one (they're assumed to be already there)."
                    (8  "#o"))
                  (number->string integer base)))
 
+(define %special-non-extended-symbols
+  ;; Special symbols that can be written without the #{...}# notation for
+  ;; extended symbols: 1+, 1-, 123/, etc.
+  (make-regexp "^[0-9]+[[:graph:]]+$" regexp/icase))
+
+(define (symbol->display-string symbol context)
+  "Return the most appropriate representation of SYMBOL, resorting to extended
+symbol notation only when strictly necessary."
+  (let ((str (symbol->string symbol)))
+    (if (regexp-exec %special-non-extended-symbols str)
+        str                                  ;no need for the #{...}# notation
+        (object->string symbol))))
+
 (define* (pretty-print-with-comments port obj
                                      #:key
                                      (format-comment
@@ -561,7 +574,8 @@ FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'."
               ((? string? str)
                (>= (+ (string-width str) 2 indent) max-width))
               ((? symbol? symbol)
-               (>= (+ (string-width (symbol->string symbol)) indent)
+               (>= (+ (string-width (symbol->display-string symbol context))
+                      indent)
                    max-width))
               ((? boolean?)
                (>= (+ 2 indent) max-width))
@@ -647,7 +661,7 @@ FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'."
        ;; and following arguments are less indented.
        (let* ((lead    (special-form-lead head context))
               (context (cons head context))
-              (head    (symbol->string head))
+              (head    (symbol->display-string head (cdr context)))
               (total   (length arguments)))
          (unless delimited? (display " " port))
          (display "(" port)
@@ -727,6 +741,8 @@ FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'."
                           (printed-string obj context))
                          ((integer? obj)
                           (integer->string obj context))
+                         ((symbol? obj)
+                          (symbol->display-string obj context))
                          (else
                           (object->string obj))))
               (len (string-width str)))
diff --git a/tests/read-print.scm b/tests/read-print.scm
index ea52a52145..79a4101be6 100644
--- a/tests/read-print.scm
+++ b/tests/read-print.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -143,6 +143,11 @@ expressions."
                    #:max-width 11)
 
 (test-pretty-print "\
+(begin
+  1+ 1- 123/ 456*
+  (1+ 41))")
+
+(test-pretty-print "\
 (lambda (x y)
   ;; This is a procedure.
   (let ((z (+ x y)))