[PATCH 1/2] Always treat bare colon as a symbol

[megane]

Hi,

Here's signed off version of Alice's patch. It all looks good to me.

The new logic enabled some refactoring, which you might find to make the
logic a bit clearer.

Here's some code you can use to test:

---

(import (chicken port) (chicken format) (chicken keyword))
(define (t s)
  (condition-case
   (let ([o (with-input-from-string s read)])
     (printf "~S ~a ~S\n" s (if (keyword? o) "-kw->" "->") (if (keyword? o) 
(keyword->string o) o)))
   [exn () (printf "ERROR: ~S\n" s)]))

(define (all style)
  (keyword-style style)
  (print "---------- " style)
  (t ":")
  (t "#:||")
  (t ":||")
  (t "||:")
  (t ":||:")
  (t ":pre")
  (t "suf:")
  (t ":|qpre|")
  (t "|qsuf|")
  (t "||")
  (t ":::tp")
  (t "ts:::")
  (t ":::aaa:::")
  (t "#:can")
  (t "#:|qcan|")
  (t "|:qpresym|")
  (t "|qsufsym:|")
  (t ":")
  (t "::")
  (t ":::")
  (t "::::")
  (t ":||:")
  (t ":| |:")
  (t "::| |::")
  (t "':")
  (t "#")
  (t ":,")
  (t ":||,")
  (t ",:||")
  (t ",||:")
  (t ",#:||")
  )

(all #:suffix)
(all #:prefix)
(all #:none)

---

>From 28b4c691780896e2c840bfdcf137d35d170f2253 Mon Sep 17 00:00:00 2001
From: alice maz <alice@alicemaz.com>
Date: Wed, 5 Aug 2020 00:07:23 -0500
Subject: [PATCH 1/2] Always treat bare colon as a symbol

Fixes ##sys#read behavior in -keyword-style prefix to match suffix
Also fixes it to consume at most one colon in -keyword-style prefix

Fixes #1710

Signed-off-by: megane <meganeka@gmail.com>
---
 library.scm             | 22 +++++++++++++---------
 tests/library-tests.scm | 15 +++++++++++----
 2 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/library.scm b/library.scm
index c5015b7a..ab3b6397 100644
--- a/library.scm
+++ b/library.scm
@@ -4031,15 +4031,18 @@ EOF
                (cond ((or (eof-object? c)
                           (char-whitespace? c)
                           (memq c terminating-characters))
-                      ;; The not null? checks here ensure we read a
-                      ;; plain ":" as a symbol, not as a keyword.
-                      ;; However, when the keyword is quoted like ||:,
-                      ;; it _should_ be read as a keyword.
-                      (if (and skw (eq? ksp #:suffix)
-                               (or qtd (not (null? (cdr lst)))))
-                          (k (##sys#reverse-list->string (cdr lst)) #t)
-                          (k (##sys#reverse-list->string lst)
-                             (and pkw (or qtd (not (null? lst)))))))
+                      ;; The various cases here cover:
+                      ;; - Nonempty keywords formed with colon in the ksp 
position
+                      ;; - Empty keywords formed explicitly with vbar quotes
+                      ;; - Bare colon, which should always be a symbol
+                      (cond ((and skw (eq? ksp #:suffix) (or qtd (not (null? 
(cdr lst)))))
+                             (k (##sys#reverse-list->string (cdr lst)) #t))
+                            ((and pkw (eq? ksp #:prefix) (or qtd (not (null? 
lst))))
+                             (k (##sys#reverse-list->string lst) #t))
+                            ((and pkw (eq? ksp #:prefix) (not qtd) (null? lst))
+                             (k ":" #f))
+                            (else
+                             (k (##sys#reverse-list->string lst) #f))))
                      ((memq c reserved-characters)
                       (reserved-character c))
                      (else
@@ -4056,6 +4059,7 @@ EOF
                            (loop (cons #\newline lst) pkw #f qtd))
                           ((#\:)
                            (cond ((and (null? lst)
+                                       (not pkw)
                                        (not qtd)
                                        (eq? ksp #:prefix))
                                   (loop '() #t #f qtd))
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index dda075f7..d331871e 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -496,10 +496,17 @@
   (assert (not (keyword? (with-input-from-string ":abc:" read))))
   (assert (not (keyword? (with-input-from-string "abc:" read)))))
 
-(let ((colon-sym (with-input-from-string ":" read)))
-  (assert (symbol? colon-sym))
-  (assert (not (keyword? colon-sym)))
-  (assert (string=? ":" (symbol->string colon-sym))))
+(parameterize ((keyword-style #:suffix))
+  (let ((colon-sym (with-input-from-string ":" read)))
+    (assert (symbol? colon-sym))
+    (assert (not (keyword? colon-sym)))
+    (assert (string=? ":" (symbol->string colon-sym)))))
+
+(parameterize ((keyword-style #:prefix))
+  (let ((colon-sym (with-input-from-string ":" read)))
+    (assert (symbol? colon-sym))
+    (assert (not (keyword? colon-sym)))
+    (assert (string=? ":" (symbol->string colon-sym)))))
 
 ;; The next two cases are a bit dubious, but we follow SRFI-88 (see
 ;; also #1625).
-- 
2.17.1

>From cda93f663f983adaed56f9071b1a40d3a96ee9d3 Mon Sep 17 00:00:00 2001
From: megane <meganeka@gmail.com>
Date: Fri, 21 Aug 2020 16:20:01 +0300
Subject: [PATCH 2/2] * library.scm (r-xtoken): Refactoring

Currently pkw turns #t precisely at the beginning of input and does
not change after that.

So we can remove the passing of pkw in the recursion and checking at
every : we see.
---
 library.scm | 24 +++++++++++-------------
 1 file changed, 11 insertions(+), 13 deletions(-)

diff --git a/library.scm b/library.scm
index ab3b6397..30ff97ec 100644
--- a/library.scm
+++ b/library.scm
@@ -4026,7 +4026,10 @@ EOF
                 (info 'symbol-info s (##sys#port-line port)) ) )))
 
          (define (r-xtoken k)
-           (let loop ((lst '()) (pkw #f) (skw #f) (qtd #f))
+           (define pkw (and (eq? ksp #:prefix)
+                            (eq? #\: (##sys#peek-char-0 port))
+                            (begin (##sys#read-char-0 port) #t)))
+           (let loop ((lst '()) (skw #f) (qtd #f))
              (let ((c (##sys#peek-char-0 port)))
                (cond ((or (eof-object? c)
                           (char-whitespace? c)
@@ -4037,9 +4040,9 @@ EOF
                       ;; - Bare colon, which should always be a symbol
                       (cond ((and skw (eq? ksp #:suffix) (or qtd (not (null? 
(cdr lst)))))
                              (k (##sys#reverse-list->string (cdr lst)) #t))
-                            ((and pkw (eq? ksp #:prefix) (or qtd (not (null? 
lst))))
+                            ((and pkw (or qtd (not (null? lst))))
                              (k (##sys#reverse-list->string lst) #t))
-                            ((and pkw (eq? ksp #:prefix) (not qtd) (null? lst))
+                            ((and pkw (not qtd) (null? lst))
                              (k ":" #f))
                             (else
                              (k (##sys#reverse-list->string lst) #f))))
@@ -4051,30 +4054,25 @@ EOF
                           ((#\|)
                            (let ((part (r-string #\|)))
                              (loop (append (##sys#fast-reverse 
(##sys#string->list part)) lst)
-                                   pkw #f #t)))
+                                   #f #t)))
                           ((#\newline)
                            (##sys#read-warning
                             port "escaped symbol syntax spans multiple lines"
                             (##sys#reverse-list->string lst))
-                           (loop (cons #\newline lst) pkw #f qtd))
+                           (loop (cons #\newline lst) #f qtd))
                           ((#\:)
-                           (cond ((and (null? lst)
-                                       (not pkw)
-                                       (not qtd)
-                                       (eq? ksp #:prefix))
-                                  (loop '() #t #f qtd))
-                                 (else (loop (cons #\: lst) pkw #t qtd))))
+                           (loop (cons #\: lst) #t qtd))
                           ((#\\)
                            (let ((c (##sys#read-char-0 port)))
                              (if (eof-object? c)
                                  (##sys#read-error
                                   port
                                   "unexpected end of file while reading 
escaped character")
-                                 (loop (cons c lst) pkw #f qtd))))
+                                 (loop (cons c lst) #f qtd))))
                           (else
                            (loop
                             (cons (if csp c (char-downcase c)) lst)
-                            pkw #f qtd)))))))))
+                            #f qtd)))))))))
          
          (define (r-char)
            ;; Code contributed by Alex Shinn
-- 
2.17.1