~ chicken-r7rs (master) fbaa912c996f19af1dec34d3c27c431b6dd130d6
commit fbaa912c996f19af1dec34d3c27c431b6dd130d6
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Tue Jul 1 21:14:21 2014 +0000
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Tue Jul 1 21:14:21 2014 +0000
Reexport scheme.base from the r7rs module
diff --git a/r7rs.scm b/r7rs.scm
index e892c8b..27f4025 100644
--- a/r7rs.scm
+++ b/r7rs.scm
@@ -17,6 +17,10 @@
;; For #u8(...) syntax.
(require-extension srfi-4)
+ ;; Reexport (scheme base).
+ (require-extension scheme.base)
+ (include "scheme.base-interface.scm")
+
(let ((old-hook ##sys#user-read-hook))
;; XXX Read syntax for "#false" and srfi-4's "#f32(...)" and friends
;; don't play nicely together, so we have to copy some of srfi-4.scm's
diff --git a/scheme.base.scm b/scheme.base.scm
index 552ed70..d0fe986 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -498,12 +498,6 @@
((null? bvs) bv)
(bytevector-copy! bv i (car bvs) 0 (car lens)))))
-;;
-;; XXX TODO There's nothing "utf8" about these at the moment! They
-;; should check their strings ("It is an error for bytevector to contain
-;; invalid UTF-8 byte sequences.").
-;;
-
(define utf8->string
(let ((bv->s (lambda (bv start . end)
(##sys#check-structure bv 'u8vector 'utf8->string)
@@ -740,7 +734,8 @@
(define peek-u8
(case-lambda
(()
- (let ((c (peek-char)))
+ (##sys#check-input-port ##sys#standard-input #t 'peek-u8)
+ (let ((c (peek-char ##sys#standard-input)))
(if (eof-object? c) c
(char->integer c))))
((port)
@@ -750,11 +745,12 @@
(char->integer c))))))
(define read-string
- (let ((read-string/eof (lambda (k port)
- (##sys#check-input-port port #t 'read-string)
- (if (eof-object? (peek-char port))
- #!eof
- (%read-string k port)))))
+ (let ((read-string/eof
+ (lambda (k port)
+ (##sys#check-input-port port #t 'read-string)
+ (if (eof-object? (peek-char port))
+ #!eof
+ (##sys#read-string/port k port)))))
(case-lambda
((k)
(read-string/eof k ##sys#standard-input))
@@ -791,12 +787,12 @@
(define read-bytevector!
(let ((read-u8vector!/eof
- (lambda (k bv . args)
- (let ((r (apply read-u8vector! k bv args)))
+ (lambda (k bv port . args)
+ (let ((r (apply read-u8vector! k bv port args)))
(if (fx= r 0) #!eof r)))))
(case-lambda
((bv)
- (read-u8vector!/eof #f bv))
+ (read-u8vector!/eof #f bv ##sys#standard-input))
((bv port)
(read-u8vector!/eof #f bv port))
((bv port start)
Trap