mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Read-in-scheme replaces boot "read" definition

Browse source 
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
This commit is contained in:
Andy Wingo 2021-03-02 21:54:42 +01:00
parent 118f0c23c4
commit 8edf1dc623
11 changed files with 62 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

2
NEWS
View file

@ -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'

1
am/bootstrap.am
View file

@ -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 \

3
module/Makefile.am
View file

@ -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 \

33
module/ice-9/boot-9.scm
View file

@ -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}
;;;

2
module/ice-9/psyntax-pp.scm
View file

@ -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

2
module/ice-9/psyntax.scm
View file

@ -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))))))))))))

31
module/ice-9/read.scm
View file

@ -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,7 +467,7 @@
(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 ch))))
(let lp ((ch ch) (res #f))
@ -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)

3
module/language/scheme/spec.scm
View file

@ -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))

6
test-suite/tests/bytevectors.test
View file

@ -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)))

9
test-suite/tests/chars.test
View file

@ -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"

12
test-suite/tests/reader.test
View file

@ -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