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

4 files changed, 47 insertions, 25 deletions

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f49516d6c..126459d16 100644
--- a/module/ice-9/boot-9.scm
+++ b/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}
 ;;;
 
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 1e30a9803..554ae0e28 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/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
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 57ac6a680..b52bb397e 100644
--- a/module/ice-9/psyntax.scm
+++ b/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))))))))))))
diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm
index 7ce4b416a..7f79bf9f9 100644
--- a/module/ice-9/read.scm
+++ b/module/ice-9/read.scm
@@ -39,24 +39,12 @@
 ;; #@-(1 2 3) => #(1 2 3)
 ;; (#*10101010102) => (#*1010101010 2)
 
-(define-module (ice-9 read)
-  #:use-module (srfi srfi-11)
-  #:use-module (rnrs bytevectors)
-  #:replace (read)
-  #:export (read-syntax))
-
-(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-syntax let*-values
+  (syntax-rules ()
+    ((_ () . body) (let () . body))
+    ((_ ((vars expr) . binds) . body)
+     (call-with-values (lambda () expr)
+       (lambda vars (let*-values binds . body))))))
 
 (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 #\-)
-                                  (values -1 (next))
-                                  (values 1 ch))))
+      (let*-values (((sign ch) (if (eqv? ch #\-)
+                                   (values -1 (next))
+                                   (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)