style: Correctly read dots in pairs and improper lists.
Until now dots were read as symbols.
* guix/scripts/style.scm (read-with-comments)[dot]: New variable.
[dot?, reverse/dot]: New procedures.
Use 'reverse/dot' instead of 'reverse' when reading lists.
* tests/style.scm ("read-with-comments: dot notation")
("((a . 1) (b . 2))", "(a b c . boom)"): New tests.
			
			
This commit is contained in:
		
							parent
							
								
									919cecd00b
								
							
						
					
					
						commit
						c9cded0955
					
				
					 2 changed files with 29 additions and 5 deletions
				
			
		|  | @ -66,8 +66,23 @@ | ||||||
| (define (read-with-comments port) | (define (read-with-comments port) | ||||||
|   "Like 'read', but include <comment> objects when they're encountered." |   "Like 'read', but include <comment> objects when they're encountered." | ||||||
|   ;; Note: Instead of implementing this functionality in 'read' proper, which |   ;; Note: Instead of implementing this functionality in 'read' proper, which | ||||||
|   ;; is the best approach long-term, this code is a later on top of 'read', |   ;; is the best approach long-term, this code is a layer on top of 'read', | ||||||
|   ;; such that we don't have to rely on a specific Guile version. |   ;; such that we don't have to rely on a specific Guile version. | ||||||
|  |   (define dot (list 'dot)) | ||||||
|  |   (define (dot? x) (eq? x dot)) | ||||||
|  | 
 | ||||||
|  |   (define (reverse/dot lst) | ||||||
|  |     ;; Reverse LST and make it an improper list if it contains DOT. | ||||||
|  |     (let loop ((result '()) | ||||||
|  |                (lst lst)) | ||||||
|  |       (match lst | ||||||
|  |         (() result) | ||||||
|  |         (((? dot?) . rest) | ||||||
|  |          (let ((dotted (reverse rest))) | ||||||
|  |            (set-cdr! (last-pair dotted) (car result)) | ||||||
|  |            dotted)) | ||||||
|  |         ((x . rest) (loop (cons x result) rest))))) | ||||||
|  | 
 | ||||||
|   (let loop ((blank-line? #t) |   (let loop ((blank-line? #t) | ||||||
|              (return (const 'unbalanced))) |              (return (const 'unbalanced))) | ||||||
|     (match (read-char port) |     (match (read-char port) | ||||||
|  | @ -85,7 +100,7 @@ | ||||||
|                                       (((? comment?) . _) #t) |                                       (((? comment?) . _) #t) | ||||||
|                                       (_ #f)) |                                       (_ #f)) | ||||||
|                                     (lambda () |                                     (lambda () | ||||||
|                                       (return (reverse lst)))) |                                       (return (reverse/dot lst)))) | ||||||
|                               lst))))) |                               lst))))) | ||||||
|              ((memv chr '(#\) #\])) |              ((memv chr '(#\) #\])) | ||||||
|               (return)) |               (return)) | ||||||
|  | @ -107,8 +122,10 @@ | ||||||
|                        (not blank-line?))) |                        (not blank-line?))) | ||||||
|              (else |              (else | ||||||
|               (unread-char chr port) |               (unread-char chr port) | ||||||
|               (read port))))))) |               (match (read port) | ||||||
| 
 |                 ((and token '#{.}#) | ||||||
|  |                  (if (eq? chr #\.) dot token)) | ||||||
|  |                 (token token)))))))) | ||||||
|  |  | ||||||
| ;;; | ;;; | ||||||
| ;;; Comment-preserving pretty-printer. | ;;; Comment-preserving pretty-printer. | ||||||
|  |  | ||||||
|  | @ -1,5 +1,5 @@ | ||||||
| ;;; GNU Guix --- Functional package management for GNU | ;;; GNU Guix --- Functional package management for GNU | ||||||
| ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org> | ;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org> | ||||||
| ;;; | ;;; | ||||||
| ;;; This file is part of GNU Guix. | ;;; This file is part of GNU Guix. | ||||||
| ;;; | ;;; | ||||||
|  | @ -377,7 +377,14 @@ | ||||||
|       (list (package-inputs (@ (my-packages) my-coreutils)) |       (list (package-inputs (@ (my-packages) my-coreutils)) | ||||||
|             (read-package-field (@ (my-packages) my-coreutils) 'inputs 4))))) |             (read-package-field (@ (my-packages) my-coreutils) 'inputs 4))))) | ||||||
| 
 | 
 | ||||||
|  | (test-equal "read-with-comments: dot notation" | ||||||
|  |   (cons 'a 'b) | ||||||
|  |   (call-with-input-string "(a . b)" | ||||||
|  |     read-with-comments)) | ||||||
|  | 
 | ||||||
| (test-pretty-print "(list 1 2 3 4)") | (test-pretty-print "(list 1 2 3 4)") | ||||||
|  | (test-pretty-print "((a . 1) (b . 2))") | ||||||
|  | (test-pretty-print "(a b c . boom)") | ||||||
| (test-pretty-print "(list 1 | (test-pretty-print "(list 1 | ||||||
|                           2 |                           2 | ||||||
|                           3 |                           3 | ||||||
|  |  | ||||||
		Reference in a new issue