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 <al...@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 <megan...@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 <megan...@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