diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 251fedaa4..944061707 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -4656,8 +4656,11 @@ R7RS." ;;; (call-with-values (lambda () - (include-from-path "ice-9/read.scm") - (values read read-syntax)) + ;; Capture syntax? binding, later removed from root + ;; module. + (let ((syntax? syntax?)) + (include-from-path "ice-9/read.scm") + (values read read-syntax))) (lambda (read* read-syntax*) (set! read read*) (set! read-syntax read-syntax*))) diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm index ccf8e3cea..ac407739f 100644 --- a/module/ice-9/read.scm +++ b/module/ice-9/read.scm @@ -877,7 +877,17 @@ (define* (read-syntax #:optional (port (current-input-port))) (define filename (port-filename port)) (define (annotate line column datum) - (datum->syntax #f ; No lexical context. - datum - #:source (vector filename line (1- column)))) + ;; Usually when reading compound expressions consisting of multiple + ;; syntax objects, like lists, the "leaves" of the expression are + ;; annotated but the "root" isn't. Like in (A . B), A and B will be + ;; annotated but the pair won't. Therefore the usually correct + ;; thing to do is to just annotate the result. However in the case + ;; of reading ( . C), the result is the already annotated C, which + ;; we don't want to re-annotate. Therefore we avoid re-annotating + ;; already annotated objects. + (if (syntax? datum) + datum + (datum->syntax #f ; No lexical context. + datum + #:source (vector filename line (1- column))))) (%read port annotate syntax->datum)) diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 231e69553..1481a0a5d 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -20,8 +20,9 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite reader) - :use-module (srfi srfi-1) - :use-module (test-suite lib)) + #:use-module (srfi srfi-1) + #:use-module (test-suite lib) + #:use-module (system syntax internal)) (define exception:eof @@ -546,6 +547,10 @@ (with-test-prefix "deprecated #{}# escapes" (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#)))) +(with-test-prefix "read-syntax" + (pass-if-equal "annotations" 'args + (syntax-expression (call-with-input-string "( . args)" read-syntax)))) + ;;; Local Variables: ;;; eval: (put 'with-read-options 'scheme-indent-function 1) ;;; End: