From 7f8efdafad827f4c38cae4f25be53b7462824e95 Mon Sep 17 00:00:00 2001 From: Peter Bex
Date: Tue, 1 Nov 2016 15:18:26 +0100 Subject: [PATCH] Improve read/write invariance of keywords (#1332). Keywords are now treated more like symbols are: when they are written, they are written using the "portable" #: representation, regardless of the current "keyword style", so they can be read back with a CHICKEN running under a different keyword style. The reader now also uses the same "extended token" reader for keywords using the "portable" representation as the style-specific reader. When writing keywords, we also check for readability, like we do with symbols. We now also support empty keywords, which can be entered through the "portable" syntax using quotation, i.e., as #:|| --- NEWS | 3 ++ library.scm | 75 +++++++++++++++++++++++-------------------------- tests/library-tests.scm | 37 +++++++++++++++++++++--- 3 files changed, 71 insertions(+), 44 deletions(-) diff --git a/NEWS b/NEWS index 631f1bf..7f0975c 100644 --- a/NEWS +++ b/NEWS @@ -65,6 +65,9 @@ - Runtime system: - "time" macro now shows peak memory usage (#1318, thanks to Kooda). +- Core libraries: + - Keywords are more consistently read/written, like symbols (#1332). + 4.11.1 - Security fixes diff --git a/library.scm b/library.scm index b150540..9594d51 100644 --- a/library.scm +++ b/library.scm @@ -3386,8 +3386,8 @@ EOF (##sys#read-char-0 port) ) ((eq? c #\.) (##sys#read-char-0 port) - (let ([c2 (##sys#peek-char-0 port)]) - (cond [(or (char-whitespace? c2) + (let ((c2 (##sys#peek-char-0 port))) + (cond ((or (char-whitespace? c2) (eq? c2 #\() (eq? c2 #\)) (eq? c2 #\") @@ -3401,22 +3401,26 @@ EOF (##sys#read-error port (starting-line "missing list terminator") - end) ) ] - [else + end) ) ) + (else (r-xtoken (lambda (tok kw) (let* ((tok (##sys#string-append "." tok)) (val - (if kw - (build-keyword tok) - (or (and (char-numeric? c2) - (##sys#string->number tok)) - (build-symbol tok)))) - (node (cons val '())) ) + (cond ((and (string=? tok ".:") + (eq? ksp #:suffix)) + ;; Edge case: r-xtoken sees + ;; a bare ":" and sets kw to #f + (build-keyword ".")) + (kw (build-keyword tok)) + ((and (char-numeric? c2) + (##sys#string->number tok))) + (else (build-symbol tok))) ) + (node (cons val '()))) (if first (##sys#setslot last 1 node) (set! first node) ) - (loop node) ))) ] ) ) ) + (loop node) ))) ) ) ) ) (else (let ([node (cons (readrec) '())]) (if first @@ -3496,10 +3500,6 @@ EOF (##sys#read-char-0 port) (loop (##sys#peek-char-0 port) (cons c lst)) ) ) ) ) - (define (r-next-token) - (r-spaces) - (r-token) ) - (define (r-symbol) (r-xtoken (lambda (str kw) @@ -3513,9 +3513,13 @@ EOF (cond ((or (eof-object? c) (char-whitespace? c) (memq c terminating-characters)) - (if (and skw (eq? ksp #:suffix)) + ;; 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) pkw))) + (k (##sys#reverse-list->string lst) + (and pkw (not (null? lst)))) ) ) ((memq c reserved-characters) (reserved-character c)) (else @@ -3623,9 +3627,7 @@ EOF (define (build-keyword tok) (##sys#intern-symbol - (if (eq? 0 (##sys#size tok)) - ":" - (##sys#string-append kwprefix tok)) )) + (##sys#string-append kwprefix tok)) ) ;; now have the state to make a decision. (set! reserved-characters @@ -3733,10 +3735,14 @@ EOF (else (list 'location (readrec)) )))) ((#\:) (##sys#read-char-0 port) - (let ((tok (r-token))) - (if (eq? 0 (##sys#size tok)) - (##sys#read-error port "empty keyword") - (build-keyword tok)))) + (let ((c (##sys#peek-char-0 port))) + (fluid-let ((ksp #f)) + (r-xtoken + (lambda (str kw) + (if (and (eq? 0 (##sys#size str)) + (not (char=? c #\|))) + (##sys#read-error port "empty keyword") + (build-keyword str))) ) ) ) ) ((#\%) (build-symbol (##sys#string-append "#" (r-token))) ) ((#\+) @@ -4027,24 +4033,13 @@ EOF ((not (##core#inline "C_blockp" x)) (outstr port "#