read-print: Improve declaration of integer bases.
This is a followup to c3b1cfe76b.
* 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.
			
			
This commit is contained in:
		
							parent
							
								
									82968362ea
								
							
						
					
					
						commit
						aaf7820d57
					
				
					 1 changed files with 28 additions and 14 deletions
				
			
		| 
						 | 
					@ -442,26 +442,40 @@ each line except the first one (they're assumed to be already there)."
 | 
				
			||||||
       (display (make-string indent #\space) port)
 | 
					       (display (make-string indent #\space) port)
 | 
				
			||||||
       (loop tail)))))
 | 
					       (loop tail)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define %symbols-followed-by-octal-integers
 | 
					(define %integer-forms
 | 
				
			||||||
  ;; Symbols for which the following integer must be printed as octal.
 | 
					  ;; Forms that take an integer as their argument, where said integer should
 | 
				
			||||||
  '(chmod umask mkdir mkstemp))
 | 
					  ;; be printed in base other than decimal base.
 | 
				
			||||||
 | 
					  (letrec-syntax ((vhashq (syntax-rules ()
 | 
				
			||||||
(define %symbols-followed-by-hexadecimal-integers
 | 
					                            ((_) vlist-null)
 | 
				
			||||||
  ;; Likewise, for hexadecimal integers.
 | 
					                            ((_ (key value) rest ...)
 | 
				
			||||||
  '(logand logior logxor lognot))
 | 
					                             (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)
 | 
					(define (integer->string integer context)
 | 
				
			||||||
  "Render INTEGER as a string using a base suitable based on 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
 | 
					  (define base
 | 
				
			||||||
    (match context
 | 
					    (match context
 | 
				
			||||||
      ((head . tail)
 | 
					      ((head . tail)
 | 
				
			||||||
       (cond ((memq head %symbols-followed-by-octal-integers) 8)
 | 
					       (match (form-base head)
 | 
				
			||||||
             ((memq head %symbols-followed-by-hexadecimal-integers)
 | 
					         (8 8)
 | 
				
			||||||
              (if (any (cut memq <> %symbols-followed-by-octal-integers)
 | 
					         (16 (if (any octal? tail) 8 16))
 | 
				
			||||||
                       tail)
 | 
					         (10 10)))
 | 
				
			||||||
                  8
 | 
					 | 
				
			||||||
                  16))
 | 
					 | 
				
			||||||
             (else 10)))
 | 
					 | 
				
			||||||
      (_ 10)))
 | 
					      (_ 10)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  (string-append (match base
 | 
					  (string-append (match base
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue