Read-in-scheme replaces boot "read" definition

Instead of defining a separate module, given that "read" calls are quite
all over the place, we're just going to replace the boot "read" binding
with read.scm.  This way, we'll be able to remove support for reader
options in the boot reader, as it will only ever be used for a finite
set of files.

* NEWS: Update.
* module/Makefile.am (ice-9/boot-9.go): Depend on read.scm.
(SOURCES):
* am/bootstrap.am (SOURCES): Don't build a ice-9/read.go, as we include
it.
* module/ice-9/boot-9.scm (read-syntax): Define here, as "include" now
uses it.
(read-hash-procedures, read-hash-procedure, read-hash-extend): New
procedures.  Will replace C variants.
(read, read-syntax): Include read.scm to define these.
* module/ice-9/psyntax-pp.scm (include): Regenerate.
* module/ice-9/psyntax.scm (include): Use read-syntax, so we get better
source information.
* module/ice-9/read.scm (let*-values): New local definition, to avoid
loading srfi-11.
(%read): Use list->typed-array instead of u8-list->bytevector.
* module/language/scheme/spec.scm: Remove (ice-9 read) import;
read-syntax is there in the boot environment

NEWS

@@ -109,7 +109,7 @@ See the newly reorganized "Foreign Function Interface", for details.
 These new interfaces replace `dynamic-link', `dynamic-pointer' and
 similar, which will eventually be deprecated.
 
-** `read-syntax' and the `(ice-9 read)' module
+** `read-syntax'
 ** `syntax-sourcev'
 ** `quote-syntax'
 

am/bootstrap.am

@@ -102,7 +102,6 @@ SOURCES =					\
   ice-9/match.scm				\
   ice-9/networking.scm				\
   ice-9/posix.scm				\
-  ice-9/read.scm				\
   ice-9/rdelim.scm				\
   ice-9/receive.scm				\
   ice-9/regex.scm				\

module/Makefile.am

@@ -27,7 +27,7 @@ modpath =
 VM_TARGETS := system/vm/assembler.go system/vm/disassembler.go
 $(VM_TARGETS): $(top_builddir)/libguile/vm-operations.h
 
-ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm ice-9/r7rs-libraries.scm
+ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm ice-9/r7rs-libraries.scm ice-9/read.scm
 ice-9/match.go: ice-9/match.scm ice-9/match.upstream.scm
 srfi/srfi-64.go: srfi/srfi-64.scm srfi/srfi-64/testing.scm
 $(nobase_ccache_DATA): ../bootstrap/ice-9/eval.go
@@ -146,7 +146,6 @@ SOURCES =					\
   ice-9/q.scm					\
   ice-9/r5rs.scm				\
   ice-9/rdelim.scm				\
-  ice-9/read.scm				\
   ice-9/receive.scm				\
   ice-9/regex.scm				\
   ice-9/runq.scm				\

module/ice-9/boot-9.scm

@@ -375,6 +375,13 @@ If returning early, return the return value of F."
 (define (resolve-module . args)
   #f)
 
+;; The definition of "include" needs read-syntax.  Replaced later.
+(define (read-syntax port)
+  (let ((datum (read port)))
+    (if (eof-object? datum)
+        datum
+        (datum->syntax #f datum))))
+
 ;; API provided by psyntax
 (define syntax-violation #f)
 (define datum->syntax #f)
@@ -2216,6 +2223,19 @@ name extensions listed in %load-extensions."
 ;;; Reader code for various "#c" forms.
 ;;;
 
+(define read-hash-procedures
+  (fluid->parameter %read-hash-procedures))
+
+(define (read-hash-procedure ch)
+  (assq-ref (read-hash-procedures) ch))
+
+(define (read-hash-extend ch proc)
+  (let ((alist (read-hash-procedures)))
+    (read-hash-procedures
+     (if proc
+         (assq-set! alist ch proc)
+         (assq-remove! alist ch)))))
+
 (define read-eval? (make-fluid #f))
 (read-hash-extend #\.
                   (lambda (c port)
@@ -4621,6 +4641,19 @@ R7RS."
 
 
 
+;;; {`read' implementation in Scheme.}
+;;;
+;;;
+
+(call-with-values (lambda ()
+                    (include-from-path "ice-9/read.scm")
+                    (values read read-syntax))
+  (lambda (read* read-syntax*)
+    (set! read read*)
+    (set! read-syntax read-syntax*)))
+
+
+
 ;;; {Threads}
 ;;;
 

module/ice-9/psyntax-pp.scm

@@ -3428,7 +3428,7 @@
                          (lambda (p)
                            (cons (make-syntax 'begin '((top)) '(hygiene guile))
                                  (let lp ()
-                                   (let ((x (read p)))
+                                   (let ((x (read-syntax p)))
                                      (if (eof-object? x) '() (cons (datum->syntax filename x) (lp)))))))))
                      tmp)
               (syntax-violation

module/ice-9/psyntax.scm

@@ -3267,7 +3267,7 @@ names."
           ;; In Guile, (cons #'a #'b) is the same as #'(a . b).
           (cons #'begin
                 (let lp ()
-                  (let ((x (read p)))
+                  (let ((x (read-syntax p)))
                     (if (eof-object? x)
                         #'()
                         (cons (datum->syntax #'filename x) (lp))))))))))))

module/ice-9/read.scm

@@ -39,24 +39,12 @@
 ;; #@-(1 2 3) => #(1 2 3)
 ;; (#*10101010102) => (#*1010101010 2)
 
-(define-module (ice-9 read)
+(define-syntax let*-values
-  #:use-module (srfi srfi-11)
+  (syntax-rules ()
-  #:use-module (rnrs bytevectors)
+    ((_ () . body) (let () . body))
-  #:replace (read)
+    ((_ ((vars expr) . binds) . body)
-  #:export (read-syntax))
+     (call-with-values (lambda () expr)
-
+       (lambda vars (let*-values binds . body))))))
-(define read-hash-procedures
-  (fluid->parameter %read-hash-procedures))
-
-(define (read-hash-procedure ch)
-  (assq-ref (read-hash-procedures) ch))
-
-(define (read-hash-extend ch proc)
-  (let ((alist (read-hash-procedures)))
-    (read-hash-procedures
-     (if proc
-         (assq-set! alist ch proc)
-         (assq-remove! alist ch)))))
 
 (define bitfield:record-positions? 0)
 (define bitfield:case-insensitive? 2)
@@ -437,7 +425,8 @@
     (expect #\u)
     (expect #\8)
     (expect #\()
-    (u8-list->bytevector (map strip-annotation (read-parenthesized #\)))))
+    (list->typed-array 'vu8 1
+                       (map strip-annotation (read-parenthesized #\)))))
 
   ;; FIXME: We should require a terminating delimiter.
   (define (read-bitvector)
@@ -478,9 +467,9 @@
         (and (not (eof-object? ch))
              (let ((digit (- (char->integer ch) (char->integer #\0))))
                (and (<= 0 digit 9) digit))))
-      (let-values (((sign ch) (if (eqv? ch #\-)
+      (let*-values (((sign ch) (if (eqv? ch #\-)
-                                  (values -1 (next))
+                                   (values -1 (next))
-                                  (values 1 ch))))
+                                   (values 1 ch))))
         (let lp ((ch ch) (res #f))
           (cond
            ((decimal-digit ch)
@@ -489,7 +478,7 @@
            (else
             (values ch (if res (* res sign) alt)))))))
     (define (read-rank ch)
-      (let-values (((ch rank) (read-decimal-integer ch 1)))
+      (let*-values (((ch rank) (read-decimal-integer ch 1)))
         (when (< rank 0)
           (error "array rank must be non-negative"))
         (when (eof-object? ch)

module/language/scheme/spec.scm

@@ -1,6 +1,6 @@
 ;;; Guile Scheme specification
 
-;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2021 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -21,7 +21,6 @@
 (define-module (language scheme spec)
   #:use-module (system base compile)
   #:use-module (system base language)
-  #:use-module (ice-9 read)
   #:use-module (language scheme compile-tree-il)
   #:use-module (language scheme decompile-tree-il)
   #:export (scheme))

test-suite/tests/bytevectors.test

@@ -1,6 +1,6 @@
 ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009-2015, 2018 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2015, 2018, 2021 Free Software Foundation, Inc.
 ;;;;
 ;;;; Ludovic Courtès
 ;;;;
@@ -645,11 +645,11 @@
     (with-input-from-string "#vu8 (1 2 3)" read))
 
   (pass-if-exception "negative integers"
-    exception:wrong-type-arg
+    exception:out-of-range
     (with-input-from-string "#vu8(-1 -2 -3)" read))
 
   (pass-if-exception "out-of-range integers"
-    exception:wrong-type-arg
+    exception:out-of-range
     (with-input-from-string "#vu8(0 256)" read)))
 
 

test-suite/tests/chars.test

@@ -1,7 +1,7 @@
 ;;;; chars.test --- Characters.       -*- coding: utf-8; mode: scheme; -*-
 ;;;; Greg J. Badros <gjb@cs.washington.edu>
 ;;;;
-;;;; Copyright (C) 2000, 2006, 2009, 2010, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2000, 2006, 2009, 2010, 2013, 2021 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -25,9 +25,6 @@
 (define exception:unknown-character-name
   (cons #t "unknown character"))
 
-(define exception:out-of-range-octal
-  (cons #t "out-of-range"))
-
 
 (with-test-prefix "basic char handling"
 
@@ -237,11 +234,11 @@
       (integer->char #x110000))
 
     (pass-if-exception "octal out of range, surrrogate" 
-                       exception:out-of-range-octal
+                       exception:out-of-range
       (with-input-from-string "#\\154000" read))
 
     (pass-if-exception "octal out of range, too big" 
-                       exception:out-of-range-octal
+                       exception:out-of-range
       (with-input-from-string "#\\4200000" read)))
 
   (with-test-prefix "case"

test-suite/tests/reader.test

@@ -1,6 +1,6 @@
 ;;;; reader.test --- Reader test.    -*- coding: iso-8859-1; mode: scheme -*-
 ;;;;
-;;;; Copyright (C) 1999, 2001-2003, 2007-2011, 2013-2015, 2020
+;;;; Copyright (C) 1999,2001-2003,2007-2011,2013-2015,2020,2021
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; Jim Blandy <jimb@red-bean.com>
@@ -25,7 +25,7 @@
 
 
 (define exception:eof
-  (cons 'read-error "end of file$"))
+  (cons 'read-error "unexpected end of input"))
 (define exception:unexpected-rparen
   (cons 'read-error "unexpected \")\"$"))
 (define exception:unexpected-rsqbracket
@@ -37,9 +37,9 @@
 (define exception:unknown-sharp-object
   (cons 'read-error "Unknown # object: .*$"))
 (define exception:eof-in-string
-  (cons 'read-error "end of file in string constant$"))
+  (cons 'read-error "end of input while reading string$"))
 (define exception:eof-in-symbol
-  (cons 'read-error "end of file while reading symbol$"))
+  (cons 'read-error "end of input while reading symbol$"))
 (define exception:invalid-escape
   (cons 'read-error "invalid character in escape sequence: .*$"))
 (define exception:missing-expression
@@ -174,10 +174,10 @@
   (pass-if "square brackets are parens"
     (equal? '() (read-string "[]")))
 
-  (pass-if-exception "paren mismatch" exception:unexpected-rparen
+  (pass-if-exception "paren mismatch" exception:mismatched-paren
                      (read-string "'[)"))
 
-  (pass-if-exception "paren mismatch (2)" exception:unexpected-rsqbracket
+  (pass-if-exception "paren mismatch (2)" exception:mismatched-paren
                      (read-string "'(]"))
 
   (pass-if-exception "paren mismatch (3)" exception:mismatched-paren