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'
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 \
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
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 \
(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)
;;; 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)
\f
+;;; {`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*)))
+
+\f
+
;;; {Threads}
;;;
(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
;; 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))))))))))))
;; #@-(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)
(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)
(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)
(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)
;;; 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
(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))
;;;; 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
;;;;
(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)))
\f
;;;; 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
(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"
(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"
;;;; 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>
(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
(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
(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
projects / platform / upstream / guile.git / commitdiff