[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Fix read.scm bugs related to nonstandard reader o
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/02: Fix read.scm bugs related to nonstandard reader options |
Date: |
Wed, 17 Feb 2021 09:37:22 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 7244461a11724c8a37e3d2e6cf9a93286f14301a
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed Feb 17 15:21:39 2021 +0100
Fix read.scm bugs related to nonstandard reader options
* module/ice-9/read.scm (compute-reader-options): Fix handling of reader
options, inline and otherwise.
---
module/ice-9/read.scm | 22 ++++++++++------------
1 file changed, 10 insertions(+), 12 deletions(-)
diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm
index af9cfd2..ae4f745 100644
--- a/module/ice-9/read.scm
+++ b/module/ice-9/read.scm
@@ -93,7 +93,7 @@
(ash (assq-ref values (and=> (memq key options) cadr)) field)))
(logior (bool 'positions bitfield:record-positions?)
(bool 'case-insensitive bitfield:case-insensitive?)
- (enum 'keyword-style '((#f . 0) (prefix . 1) (postfix . 2))
+ (enum 'keywords '((#f . 0) (prefix . 1) (postfix . 2))
bitfield:keyword-style)
(bool 'r6rs-hex-escapes bitfield:r6rs-escapes?)
(bool 'square-brackets bitfield:square-brackets?)
@@ -102,15 +102,13 @@
(bool 'r7rs-symbols bitfield:r7rs-symbols?))))
(define (set-option options field new)
- (logior new (logand options (lognot (ash #b11 field)))))
+ (logior (ash new field) (logand options (lognot (ash #b11 field)))))
(define (set-port-read-option! port field value)
- (let ((options (or (%port-property port 'port-read-options)
- read-options-inherit-all))
- (new (ash value field)))
- (%set-port-property! port 'port-read-options
- (set-option options field new)
- )))
+ (%set-port-property! port 'port-read-options
+ (set-option (or (%port-property port 'port-read-options)
+ read-options-inherit-all)
+ field value)))
(define* (read #:optional (port (current-input-port)))
;; init read options
@@ -208,7 +206,7 @@
(len (string-length str)))
(cond
((and (eq? (keyword-style) keyword-style-postfix)
- (> len 0) (eqv? #\: (string-ref str (1- len))))
+ (> len 1) (eqv? #\: (string-ref str (1- len))))
(let ((str (substring str 0 (1- len))))
(symbol->keyword
(string->symbol
@@ -325,9 +323,9 @@
;; Skip intraline whitespace before continuing.
(let lp ()
(let ((ch (peek)))
- (unless (or (eof-object? ch)
- (eqv? ch #\tab)
- (eq? (char-general-category ch) 'Zs))
+ (when (and (not (eof-object? ch))
+ (or (eqv? ch #\tab)
+ (eq? (char-general-category ch) 'Zs)))
(next)
(lp))))))
;; Accept "\(" for use at the beginning of