Hi all, Pretty straightforward patch. I decided to get rid of the mutation of pkw and use it in "loop" because I found it a bit confusing to have skw in the loop and pkw as a mutable lexical var, so sorry for the large patch. It doesn't really change all that much.
Other than moving pkw into the loop args, we need to remember if the expression was pipe-quoted so I added that as an additional argument for "loop". This needs to be checked when encountering a : when it's the first thing we've seen in prefix mode. If there were quote bars before the colon, it's not really the first thing, so it shouldn't be seen as a keyword. Finally we add an "or quoted" check to the empty list check when deciding whether to make a keyword or a symbol. The second patch completes SRFI-88 support by registering a module for it and adding the feature identifier (which I think was just an oversight). Strictly speaking, we might not define the identifier when keyword mode is prefix or none, but then we still do have the srfi-88 procedures, so I'm not 100% sure. We could let the features procedure check the keyword style and add srfi-88 dynamically if it's #:suffix only... Cheers, Peter
From 3b1eca1c2173bfde3860cec21cf084d5d2d6abf8 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 29 Jun 2019 16:48:13 +0200
Subject: [PATCH 1/2] Read quoted empty keywords as keywords
This also fixes a long-standing weird edge case marked with "XXX" in
the test suite where abc:|| would be read as a keyword in suffix mode.
Fixes #1625
---
NEWS | 6 ++++
library.scm | 88 +++++++++++++++++++++++++------------------------
tests/library-tests.scm | 38 ++++++++++++++-------
3 files changed, 78 insertions(+), 54 deletions(-)
diff --git a/NEWS b/NEWS
index e15ec4e3..2ebee3f0 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,11 @@
5.1.1
+- Runtime system
+ - Quoted empty keywords like ||: and :|| are now read like prescribed
+ by SRFI-88 in the corresponding keyword mode. Symbols containing
+ quoted empty prefixes or suffixes like ||abc: and abc:|| will be
+ read correctly as symbols now (fixes #1625, thanks to Andy Bennett).
+
- Compiler
- Fixed a bug in lfa2 pass which caused "if" or "cond" nodes to be
incorrectly unboxed if the "else" branch had a flonum result type
diff --git a/library.scm b/library.scm
index 994efc4d..78b92a1f 100644
--- a/library.scm
+++ b/library.scm
@@ -4016,49 +4016,51 @@ EOF
(info 'symbol-info s (##sys#port-line port)) ) )))
(define (r-xtoken k)
- (let ((pkw #f))
- (let loop ((lst '()) (skw #f))
- (let ((c (##sys#peek-char-0 port)))
- (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.
- (if (and skw (eq? ksp #:suffix)
- (not (null? (cdr lst))))
- (k (##sys#reverse-list->string (cdr lst)) #t)
- (k (##sys#reverse-list->string lst)
- (and pkw (not (null? lst))))))
- ((memq c reserved-characters)
- (reserved-character c))
- (else
- (let ((c (##sys#read-char-0 port)))
- (case c
- ((#\|)
- (let ((part (r-string #\|)))
- (loop (append (##sys#fast-reverse (##sys#string->list part)) lst)
- #f)))
- ((#\newline)
- (##sys#read-warning
- port "escaped symbol syntax spans multiple lines"
- (##sys#reverse-list->string lst))
- (loop (cons #\newline lst) #f))
- ((#\:)
- (cond ((and (null? lst) (eq? ksp #:prefix))
- (set! pkw #t)
- (loop '() #f))
- (else (loop (cons #\: lst) #t))))
- ((#\\)
- (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) #f))))
- (else
- (loop
- (cons (if csp c (char-downcase c)) lst)
- #f))))))))))
+ (let loop ((lst '()) (pkw #f) (skw #f) (qtd #f))
+ (let ((c (##sys#peek-char-0 port)))
+ (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)))))))
+ ((memq c reserved-characters)
+ (reserved-character c))
+ (else
+ (let ((c (##sys#read-char-0 port)))
+ (case c
+ ((#\|)
+ (let ((part (r-string #\|)))
+ (loop (append (##sys#fast-reverse (##sys#string->list part)) lst)
+ pkw #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))
+ ((#\:)
+ (cond ((and (null? lst)
+ (not qtd)
+ (eq? ksp #:prefix))
+ (loop '() #t #f qtd))
+ (else (loop (cons #\: lst) pkw #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))))
+ (else
+ (loop
+ (cons (if csp c (char-downcase c)) lst)
+ pkw #f qtd)))))))))
(define (r-char)
;; Code contributed by Alex Shinn
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index eb380d73..8d9e3b24 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -449,6 +449,7 @@
(parameterize ((keyword-style #:suffix))
(assert (keyword? (with-input-from-string "abc:" read)))
(assert (keyword? (with-input-from-string "|abc|:" read)))
+ (assert (keyword? (with-input-from-string "a|bc|d:" read)))
(assert (not (keyword? (with-input-from-string "abc:||" read))))
(assert (not (keyword? (with-input-from-string "abc\\:" read))))
(assert (not (keyword? (with-input-from-string "abc|:|" read))))
@@ -457,12 +458,15 @@
(parameterize ((keyword-style #:prefix))
(assert (keyword? (with-input-from-string ":abc" read)))
(assert (keyword? (with-input-from-string ":|abc|" read)))
- (assert (keyword? (with-input-from-string "||:abc" read))) ;XXX should be not
+ (assert (keyword? (with-input-from-string ":a|bc|d" read)))
+ (assert (not (keyword? (with-input-from-string "||:abc" read))))
(assert (not (keyword? (with-input-from-string "\\:abc" read))))
(assert (not (keyword? (with-input-from-string "|:|abc" read))))
(assert (not (keyword? (with-input-from-string "|:abc|" read)))))
(parameterize ((keyword-style #f))
+ (assert (not (keyword? (with-input-from-string ":||" read))))
+ (assert (not (keyword? (with-input-from-string "||:" read))))
(assert (not (keyword? (with-input-from-string ":abc" read))))
(assert (not (keyword? (with-input-from-string ":abc:" read))))
(assert (not (keyword? (with-input-from-string "abc:" read)))))
@@ -472,17 +476,29 @@
(assert (not (keyword? colon-sym)))
(assert (string=? ":" (symbol->string colon-sym))))
-;; The next two cases are a bit dubious. These could also be read as
-;; keywords due to the literal quotation.
-(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).
+(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))))
-(let ((colon-sym (with-input-from-string "||:" read)))
- (assert (symbol? colon-sym))
- (assert (not (keyword? colon-sym)))
- (assert (string=? ":" (symbol->string colon-sym))))
+ (let ((empty-kw (with-input-from-string "||:" read)))
+ (assert (not (symbol? empty-kw)))
+ (assert (keyword? empty-kw))
+ (assert (string=? "" (keyword->string empty-kw)))))
+
+(parameterize ((keyword-style #:prefix))
+ (let ((empty-kw (with-input-from-string ":||" read)))
+ (assert (not (symbol? empty-kw)))
+ (assert (keyword? empty-kw))
+ (assert (string=? "" (keyword->string empty-kw))))
+
+ (let ((colon-sym (with-input-from-string "||:" read)))
+ (assert (symbol? colon-sym))
+ (assert (not (keyword? colon-sym)))
+ (assert (string=? ":" (symbol->string colon-sym)))))
(assert-fail (with-input-from-string "#:" read))
--
2.11.0
From b6405910d4d1e3e51420cf176148b471579793e0 Mon Sep 17 00:00:00 2001
From: Peter Bex <pe...@more-magic.net>
Date: Sat, 29 Jun 2019 17:02:01 +0200
Subject: [PATCH 2/2] Define a srfi-88 module as a subset of chicken.keyword
This module contains only keyword?, keyword->string and
string->keyword.
---
NEWS | 5 +++++
library.scm | 3 ++-
manual/Module (chicken keyword) | 4 ++++
modules.scm | 6 ++++++
4 files changed, 17 insertions(+), 1 deletion(-)
diff --git a/NEWS b/NEWS
index 2ebee3f0..5b929416 100644
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,11 @@
quoted empty prefixes or suffixes like ||abc: and abc:|| will be
read correctly as symbols now (fixes #1625, thanks to Andy Bennett).
+- Core libraries
+ - There is now a srfi-88 module which contains just the three
+ procedures from the (chicken keyword) module defined by the SRFI.
+ - A feature identifier named "srfi-88" is now registered.
+
- Compiler
- Fixed a bug in lfa2 pass which caused "if" or "cond" nodes to be
incorrectly unboxed if the "else" branch had a flonum result type
diff --git a/library.scm b/library.scm
index 78b92a1f..56c8ef21 100644
--- a/library.scm
+++ b/library.scm
@@ -6490,7 +6490,8 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
(define ##sys#features
'(#:chicken
- #:srfi-6 #:srfi-12 #:srfi-17 #:srfi-23 #:srfi-30 #:srfi-39 #:srfi-62 #:full-numeric-tower))
+ #:srfi-6 #:srfi-8 #:srfi-12 #:srfi-17 #:srfi-23 #:srfi-30
+ #:srfi-39 #:srfi-62 #:srfi-88 #:full-numeric-tower))
;; Add system features:
diff --git a/manual/Module (chicken keyword) b/manual/Module (chicken keyword)
index 72038fa1..0d05ed0f 100644
--- a/manual/Module (chicken keyword)
+++ b/manual/Module (chicken keyword)
@@ -17,6 +17,10 @@ either compatible to Common LISP, or to DSSSL. As long as this
parameter is set to {{#:suffix}}, CHICKEN conforms to
[[http://srfi.schemers.org/srfi-88/srfi-88.html|SRFI-88]].
+There is also a {{srfi-88}} or {{(srfi 88)}} module which only
+includes the standard procedures from the SRFI document, without the
+CHICKEN extensions. {{(chicken keyword)}} offers the complete set of
+procedures, both CHICKEN-specific and standard SRFI-88.
==== get-keyword
diff --git a/modules.scm b/modules.scm
index c1442a03..a7fb3f18 100644
--- a/modules.scm
+++ b/modules.scm
@@ -1110,6 +1110,12 @@
'srfi-55 '() (se-subset '(require-extension) ##sys#chicken.base-macro-environment))
(##sys#register-core-module
+ 'srfi-88 'library
+ '((keyword? . chicken.keyword#keyword?)
+ (keyword->string chicken.keyword#keyword->string)
+ (string->keyword chicken.keyword#string->keyword)))
+
+(##sys#register-core-module
'srfi-98 'posix
'((get-environment-variable . chicken.process-context#get-environment-variable)
(get-environment-variables . chicken.process-context#get-environment-variables)))
--
2.11.0
signature.asc
Description: PGP signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
