summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-04-13 17:56:37 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-14 14:48:20 +0200
commitc9cded095593783a957ea500160587252d5cadf6 (patch)
treeb746ae4f0ab22f6a070ccfe07cf886a7f0cd22cd /guix
parent919cecd00b018d596cf8aca10b370c4d91989be9 (diff)
downloadguix-patches-c9cded095593783a957ea500160587252d5cadf6.tar
guix-patches-c9cded095593783a957ea500160587252d5cadf6.tar.gz
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/style.scm25
1 files changed, 21 insertions, 4 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.