read-print: Guess the base to use for integers being printed.
Fixes <https://issues.guix.gnu.org/57090>. Reported by Christopher Rodriguez <yewscion@gmail.com>. * guix/read-print.scm (%symbols-followed-by-octal-integers) (%symbols-followed-by-hexadecimal-integers): New variables. * guix/read-print.scm (integer->string): New procedure. (pretty-print-with-comments): Use it. * tests/read-print.scm: Add test.
This commit is contained in:
		
							parent
							
								
									8cf7997d7c
								
							
						
					
					
						commit
						c3b1cfe76b
					
				
					 2 changed files with 43 additions and 3 deletions
				
			
		|  | @ -22,6 +22,7 @@ | |||
|   #:use-module (ice-9 rdelim) | ||||
|   #:use-module (ice-9 vlist) | ||||
|   #:use-module (srfi srfi-1) | ||||
|   #:use-module (srfi srfi-26) | ||||
|   #:use-module (srfi srfi-34) | ||||
|   #:use-module (srfi srfi-35) | ||||
|   #:use-module (guix i18n) | ||||
|  | @ -426,6 +427,34 @@ 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->string integer context) | ||||
|   "Render INTEGER as a string using a base suitable based on CONTEXT." | ||||
|   (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))) | ||||
|       (_ 10))) | ||||
| 
 | ||||
|   (string-append (match base | ||||
|                    (10 "") | ||||
|                    (16 "#x") | ||||
|                    (8  "#o")) | ||||
|                  (number->string integer base))) | ||||
| 
 | ||||
| (define* (pretty-print-with-comments port obj | ||||
|                                      #:key | ||||
|                                      (format-comment | ||||
|  | @ -661,9 +690,12 @@ FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'." | |||
|              (display ")" port) | ||||
|              (+ column 1))))) | ||||
|       (_ | ||||
|        (let* ((str (if (string? obj) | ||||
|                        (escaped-string obj) | ||||
|                        (object->string obj))) | ||||
|        (let* ((str (cond ((string? obj) | ||||
|                           (escaped-string obj)) | ||||
|                          ((integer? obj) | ||||
|                           (integer->string obj context)) | ||||
|                          (else | ||||
|                           (object->string obj)))) | ||||
|               (len (string-width str))) | ||||
|          (if (and (> (+ column 1 len) max-width) | ||||
|                   (not delimited?)) | ||||
|  |  | |||
|  | @ -247,6 +247,14 @@ mnopqrstuvwxyz.\")" | |||
|            (+ a b)))) | ||||
|   (list x y z))") | ||||
| 
 | ||||
| (test-pretty-print "\ | ||||
| (begin | ||||
|   (chmod \"foo\" #o750) | ||||
|   (chmod port | ||||
|          (logand #o644 | ||||
|                  (lognot (umask)))) | ||||
|   (logand #x7f xyz))") | ||||
| 
 | ||||
| (test-pretty-print "\ | ||||
| (substitute-keyword-arguments (package-arguments x) | ||||
|   ((#:phases phases) | ||||
|  |  | |||
		Reference in a new issue