From c9cded095593783a957ea500160587252d5cadf6 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Apr 2022 17:56:37 +0200
Subject: 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 +++++++++++++++++++++----
 1 file changed, 21 insertions(+), 4 deletions(-)

(limited to 'guix/scripts/style.scm')

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.
-- 
cgit v1.2.3