Guarantee that all input ports have a READ-SUBSTRING operation.

Implement procedures READ-STRING! and READ-LINE.

diff --git a/v7/src/runtime/chrset.scm b/v7/src/runtime/chrset.scm
index ccd5f23ada86172b3fe2ce91665f2edcb2d6f731..b88ca3cd671af995af13716bfaac258154af2537 100644 (file)
--- a/v7/src/runtime/chrset.scm
+++ b/v7/src/runtime/chrset.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: chrset.scm,v 14.4 1995/11/07 04:39:57 adams Exp $
+$Id: chrset.scm,v 14.5 1997/02/21 05:42:22 cph Exp $
 
-Copyright (c) 1988-1995 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -42,8 +42,6 @@ MIT in each case. |#
        (= (string-length object) 256)
        (not (string-find-next-char-in-set object char-set:not-01))))
 
-(define char-set:not-01)
-
 (define (char-set . chars)
   (chars->char-set chars))
 
@@ -123,6 +121,8 @@ MIT in each case. |#
 (define char-set:alphabetic)
 (define char-set:alphanumeric)
 (define char-set:standard)
+(define char-set:not-01)
+(define char-set:newline)
 
 (define (initialize-package!)
   (set! char-set:upper-case (ascii-range->char-set #x41 #x5B))
@@ -139,7 +139,9 @@ MIT in each case. |#
        (char-set-union char-set:alphabetic char-set:numeric))
   (set! char-set:standard
        (char-set-union char-set:graphic (char-set char:newline)))
-  (set! char-set:not-01 (ascii-range->char-set #x02 #x100)))
+  (set! char-set:not-01 (ascii-range->char-set #x02 #x100))
+  (set! char-set:newline (char-set char:newline))
+  unspecific)
 
 (define-integrable (char-upper-case? char)
   (char-set-member? char-set:upper-case char))

diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index 086a16313fc4aae871965cc6955cfbe816a0611c..8010ef1d00a2d1723fd139399996c56a2e959f66 100644 (file)
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: input.scm,v 14.16 1993/10/21 11:49:45 cph Exp $
+$Id: input.scm,v 14.17 1997/02/21 05:42:32 cph Exp $
 
-Copyright (c) 1988-93 Massachusetts Institute of Technology
+Copyright (c) 1988-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -57,6 +57,18 @@ MIT in each case. |#
 (define (input-port/discard-chars port delimiters)
   ((input-port/operation/discard-chars port) port delimiters))
 
+(define (input-port/read-substring! port string start end)
+  ((input-port/operation/read-substring port) port string start end))
+
+(define (input-port/read-string! port string)
+  (input-port/read-substring! port string 0 (string-length string)))
+
+(define (input-port/read-line port)
+  (let ((line (input-port/read-string port char-set:newline)))
+    ;; Discard delimiter, if any -- this is a no-op at EOF.
+    (input-port/discard-char port)
+    line))
+
 (define eof-object
   "EOF Object")
 
@@ -124,4 +136,21 @@ MIT in each case. |#
                    (guarantee-input-port port))
                (if (default-object? parser-table)
                    (current-parser-table)
-                   parser-table)))
\ No newline at end of file
+                   parser-table)))
+
+(define (read-line #!optional port)
+  (input-port/read-line (if (default-object? port)
+                           (current-input-port)
+                           (guarantee-input-port port))))
+
+(define (read-string! string #!optional start end port)
+  (input-port/read-substring! string
+                             (if (default-object? start)
+                                 0
+                                 start)
+                             (if (default-object? end)
+                                 (string-length string)
+                                 end)
+                             (if (default-object? port)
+                                 (current-input-port)
+                                 (guarantee-input-port port))))
\ No newline at end of file

diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index c1c3dd51079548ef919b9a066cb4ecc8198c5105..aaa4ca41484e930b283f0632e67b39a3507f861b 100644 (file)
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.8 1994/08/15 19:14:15 cph Exp $
+$Id: port.scm,v 1.9 1997/02/21 05:42:40 cph Exp $
 
-Copyright (c) 1991-94 Massachusetts Institute of Technology
+Copyright (c) 1991-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -50,6 +50,7 @@ MIT in each case. |#
       DISCARD-CHAR
       READ-STRING
       DISCARD-CHARS
+      READ-SUBSTRING
       ;; output operations:
       WRITE-CHAR
       WRITE-STRING
@@ -84,6 +85,9 @@ MIT in each case. |#
 (define input-port/operation/discard-chars
   (record-accessor port-rtd 'DISCARD-CHARS))
 
+(define input-port/operation/read-substring
+  (record-accessor port-rtd 'READ-SUBSTRING))
+
 (define output-port/operation/write-char
   (record-accessor port-rtd 'WRITE-CHAR))
 
@@ -98,7 +102,7 @@ MIT in each case. |#
 
 (define output-port/operation/discretionary-flush
   (record-accessor port-rtd 'DISCRETIONARY-FLUSH-OUTPUT))
-
+\f
 (set-record-type-unparser-method! port-rtd
   (lambda (state port)
     ((let ((name
@@ -116,7 +120,7 @@ MIT in each case. |#
              (standard-unparser-method name #f))))
      state
      port)))
-\f
+
 (define (port/copy port state)
   (let ((port (record-copy port)))
     (set-port/state! port state)
@@ -285,7 +289,7 @@ MIT in each case. |#
 (define install-input-operations!
   (let ((operation-names
         '(CHAR-READY? PEEK-CHAR READ-CHAR
-                      DISCARD-CHAR READ-STRING DISCARD-CHARS)))
+                      DISCARD-CHAR READ-STRING DISCARD-CHARS READ-SUBSTRING)))
     (let ((updaters
           (map (lambda (name)
                  (record-updater port-rtd name))
@@ -309,7 +313,8 @@ MIT in each case. |#
                              false
                              (caddr operations)
                              default-operation/read-string
-                             default-operation/discard-chars)
+                             default-operation/discard-chars
+                             default-operation/read-substring)
                        operation-names)
              (set-port/operation-names!
               port
@@ -322,7 +327,7 @@ MIT in each case. |#
              (for-each (lambda (updater)
                          (updater port false))
                        updaters)))))))
-
+\f
 (define (default-operation/char-ready? port interval)
   port interval
   true)
@@ -356,6 +361,22 @@ MIT in each case. |#
            (begin
              (discard-char port)
              (loop)))))))
+
+(define (default-operation/read-substring port string start end)
+  (let ((read-char (input-port/operation/read-char port)))
+    (let loop ((index start))
+      (if (fix:< index end)
+         (let ((char (read-char port)))
+           (cond ((not char)
+                  (if (fix:= index start)
+                      #f
+                      (fix:- index start)))
+                 ((eof-object? char)
+                  (fix:- index start))
+                 (else
+                  (string-set! string index char)
+                  (loop (fix:+ index 1)))))
+         (fix:- index start)))))
 \f
 ;;;; Output Operations
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index f99123eb021a981275ad0a4d3b3114d4bbee9e70..9090478e7c56a570fffc651904ecb23d078cf048 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.274 1997/01/05 23:45:13 cph Exp $
+$Id: runtime.pkg,v 14.275 1997/02/21 05:42:58 cph Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -205,6 +205,7 @@ MIT in each case. |#
          char-set:alphanumeric
          char-set:graphic
          char-set:lower-case
+         char-set:newline
          char-set:not-graphic
          char-set:not-whitespace
          char-set:numeric
@@ -1012,6 +1013,7 @@ MIT in each case. |#
          input-port/operation/peek-char
          input-port/operation/read-char
          input-port/operation/read-string
+         input-port/operation/read-substring
          input-port/state
          input-port?
          interaction-i/o-port
@@ -1086,13 +1088,18 @@ MIT in each case. |#
          input-port/discard-chars
          input-port/peek-char
          input-port/read-char
+         input-port/read-line
          input-port/read-string
+         input-port/read-string!
+         input-port/read-substring!
          make-eof-object
          peek-char
          read
          read-char
          read-char-no-hang
-         read-string)
+         read-line
+         read-string
+         read-string!)
   (export (runtime primitive-io)
          eof-object))
 

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 93bd7227a54550200db7fee32f7761b2a8894697..2b98b47962f217ad12576bd4d36bcf735cb099a7 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.281 1997/01/05 23:45:04 cph Exp $
+$Id: runtime.pkg,v 14.282 1997/02/21 05:42:48 cph Exp $
 
 Copyright (c) 1988-97 Massachusetts Institute of Technology
 
@@ -205,6 +205,7 @@ MIT in each case. |#
          char-set:alphanumeric
          char-set:graphic
          char-set:lower-case
+         char-set:newline
          char-set:not-graphic
          char-set:not-whitespace
          char-set:numeric
@@ -1012,6 +1013,7 @@ MIT in each case. |#
          input-port/operation/peek-char
          input-port/operation/read-char
          input-port/operation/read-string
+         input-port/operation/read-substring
          input-port/state
          input-port?
          interaction-i/o-port
@@ -1086,13 +1088,18 @@ MIT in each case. |#
          input-port/discard-chars
          input-port/peek-char
          input-port/read-char
+         input-port/read-line
          input-port/read-string
+         input-port/read-string!
+         input-port/read-substring!
          make-eof-object
          peek-char
          read
          read-char
          read-char-no-hang
-         read-string)
+         read-line
+         read-string
+         read-string!)
   (export (runtime primitive-io)
          eof-object))