diff options
| -rw-r--r-- | guix/scripts/style.scm | 25 | ||||
| -rw-r--r-- | tests/style.scm | 9 |
2 files changed, 29 insertions, 5 deletions
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm index fb31c694f2..8123570c38 100644 --- a/guix/scripts/style.scm +++ b/guix/scripts/style.scm @@ -66,8 +66,23 @@ (define (read-with-comments port) "Like 'read', but include <comment> objects when they're encountered." ;; 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. + (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) (return (const 'unbalanced))) (match (read-char port) @@ -85,7 +100,7 @@ (((? comment?) . _) #t) (_ #f)) (lambda () - (return (reverse lst)))) + (return (reverse/dot lst)))) lst))))) ((memv chr '(#\) #\])) (return)) @@ -107,8 +122,10 @@ (not blank-line?))) (else (unread-char chr port) - (read port))))))) - + (match (read port) + ((and token '#{.}#) + (if (eq? chr #\.) dot token)) + (token token)))))))) ;;; ;;; Comment-preserving pretty-printer. diff --git a/tests/style.scm b/tests/style.scm index 8c6d37a661..41f7e31cce 100644 --- a/tests/style.scm +++ b/tests/style.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -377,7 +377,14 @@ (list (package-inputs (@ (my-packages) my-coreutils)) (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 "((a . 1) (b . 2))") +(test-pretty-print "(a b c . boom)") (test-pretty-print "(list 1 2 3 |