~ 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