Change read-string to match R7RS.

Rename previous definition to read-delimited-string.
Also tweak read-string! to have optional arguments like read-bytevector!.

diff --git a/src/runtime/input.scm b/src/runtime/input.scm
index 8de16f526c2f944f55e51922c3ed74c677644295..44986b9d2dc9a717b5a145d833b85581a0d2165e 100644 (file)
--- a/src/runtime/input.scm
+++ b/src/runtime/input.scm
@@ -140,7 +140,7 @@ USA.
         (if (default-object? interval)
             0
             (begin
-              (guarantee-exact-nonnegative-integer interval 'CHAR-READY?)
+              (guarantee exact-nonnegative-integer? interval 'CHAR-READY?)
               interval))))
     (if (positive? interval)
        (let ((timeout (+ (real-time-clock) interval)))
@@ -157,7 +157,7 @@ USA.
          (loop)))))
 
 (define (unread-char char #!optional port)
-  (guarantee-char char 'UNREAD-CHAR)
+  (guarantee char? char 'UNREAD-CHAR)
   (input-port/unread-char (optional-input-port port 'UNREAD-CHAR) char))
 
 (define (peek-char #!optional port)
@@ -173,9 +173,25 @@ USA.
             (eof-object)
             (input-port/read-char port)))))
 
-(define (read-string delimiters #!optional port)
+(define (read-string k #!optional port)
+  (if (char-set? k)
+      (read-delimited-string k port)
+      (r7rs-read-string k port)))
+
+(define (read-delimited-string delimiters #!optional port)
   (input-port/read-string (optional-input-port port 'READ-STRING) delimiters))
 
+(define (r7rs-read-string k #!optional port)
+  (guarantee index-fixnum? k 'read-string)
+  (let ((port (optional-input-port port 'read-string)))
+    (if (fix:> k 0)
+       (let ((string (make-string k)))
+         (let ((n (input-port/read-string! port string)))
+           (cond ((not n) n)
+                 ((fix:> n 0) (if (fix:< n k) (substring string 0 n) string))
+                 (else (eof-object)))))
+       (make-string 0))))
+\f
 (define (read #!optional port environment)
   (parse-object (optional-input-port port 'READ) environment))
 
@@ -195,12 +211,29 @@ USA.
 (define (read-line #!optional port)
   (input-port/read-line (optional-input-port port 'READ-LINE)))
 
-(define (read-string! string #!optional port)
-  (input-port/read-string! (optional-input-port port 'READ-STRING!) string))
+(define (read-string! string #!optional port start end)
+  (let ((port (optional-input-port port 'read-string!))
+       (end
+        (if (default-object? end)
+            (xstring-length string)
+            (begin
+              (guarantee index-fixnum? end 'read-string!)
+              (if (not (fix:<= end (xstring-length string)))
+                  (error:bad-range-argument end 'read-string!))
+              end))))
+    (let ((start
+          (if (default-object? start)
+              0
+              (begin
+                (guarantee index-fixnum? start 'read-string!)
+                (if (not (fix:<= start end))
+                    (error:bad-range-argument start 'read-string!))
+                start))))
+      (input-port/read-substring! port string start end))))
+
 
 (define (read-substring! string start end #!optional port)
-  (input-port/read-substring! (optional-input-port port 'READ-SUBSTRING!)
-                             string start end))
+  (read-string! string port start end))
 
 (define (optional-input-port port caller)
   (let ((port (if (default-object? port) (current-input-port) port)))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 681b6e89a0c9e711731f92909b8a703929b72462..8db5f25a4b26b8f796f60ac95639f2a8c1a6cc53 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2624,6 +2624,7 @@ USA.
          read
          read-char
          read-char-no-hang
+         read-delimited-string
          read-file
          read-line
          read-string