01/07: style: Correctly read dots in pairs and improper lists.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit c9cded095593783a957ea500160587252d5cadf6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Apr 13 17:56:37 2022 +0200

    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.
---
 guix/scripts/style.scm | 25 +++++++++++++++++++++----
 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