[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/07: Read-in-scheme replaces boot "read" definition
From: |
Andy Wingo |
Subject: |
[Guile-commits] 07/07: Read-in-scheme replaces boot "read" definition |
Date: |
Wed, 3 Mar 2021 11:09:29 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 8edf1dc6231eb7b574cc63176e55ac25c0e71330
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Mar 2 21:54:42 2021 +0100
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 | 2 +-
am/bootstrap.am | 1 -
module/Makefile.am | 3 +--
module/ice-9/boot-9.scm | 33 +++++++++++++++++++++++++++++++++
module/ice-9/psyntax-pp.scm | 2 +-
module/ice-9/psyntax.scm | 2 +-
module/ice-9/read.scm | 35 ++++++++++++-----------------------
module/language/scheme/spec.scm | 3 +--
test-suite/tests/bytevectors.test | 6 +++---
test-suite/tests/chars.test | 9 +++------
test-suite/tests/reader.test | 12 ++++++------
11 files changed, 62 insertions(+), 46 deletions(-)
diff --git a/NEWS b/NEWS
index c42896a..54cee9a 100644
--- a/NEWS
+++ b/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'
diff --git a/am/bootstrap.am b/am/bootstrap.am
index 2f5804f..acc00c7 100644
--- a/am/bootstrap.am
+++ b/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 \
diff --git a/module/Makefile.am b/module/Makefile.am
index 516fb3a..b836812 100644
--- a/module/Makefile.am
+++ b/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 \
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f49516d..126459d 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 1e30a98..554ae0e 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 57ac6a6..b52bb39 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 7ce4b41..7f79bf9 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)
diff --git a/module/language/scheme/spec.scm b/module/language/scheme/spec.scm
index b150053..18af552 100644
--- a/module/language/scheme/spec.scm
+++ b/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))
diff --git a/test-suite/tests/bytevectors.test
b/test-suite/tests/bytevectors.test
index 5d4568d..9ae040f 100644
--- a/test-suite/tests/bytevectors.test
+++ b/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)))
diff --git a/test-suite/tests/chars.test b/test-suite/tests/chars.test
index 55cfead..0a3b314 100644
--- a/test-suite/tests/chars.test
+++ b/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"
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index ef11a4a..203d406 100644
--- a/test-suite/tests/reader.test
+++ b/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
- [Guile-commits] branch master updated (54adbd6 -> 8edf1dc), Andy Wingo, 2021/03/03
- [Guile-commits] 02/07: Invalid charset at EOF does not cause decoding error, Andy Wingo, 2021/03/03
- [Guile-commits] 03/07: Fix reader extensions in Scheme reader, Andy Wingo, 2021/03/03
- [Guile-commits] 04/07: Fix reading neoteric exprs in Scheme reader, Andy Wingo, 2021/03/03
- [Guile-commits] 01/07: Remove textual-ports include from (ice-9 read), Andy Wingo, 2021/03/03
- [Guile-commits] 05/07: Fix unterminated #!...!# error message in Scheme reader, Andy Wingo, 2021/03/03
- [Guile-commits] 06/07: Relax srfi-105 source expectations, Andy Wingo, 2021/03/03
- [Guile-commits] 07/07: Read-in-scheme replaces boot "read" definition,
Andy Wingo <=