From 7191c8ed16cab610a5765ac6332cd7f442317f8a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 21 Feb 1997 05:42:58 +0000 Subject: [PATCH] Guarantee that all input ports have a READ-SUBSTRING operation. Implement procedures READ-STRING! and READ-LINE. --- v7/src/runtime/chrset.scm | 12 +++++++----- v7/src/runtime/input.scm | 35 ++++++++++++++++++++++++++++++++--- v7/src/runtime/port.scm | 35 ++++++++++++++++++++++++++++------- v7/src/runtime/runtime.pkg | 11 +++++++++-- v8/src/runtime/runtime.pkg | 11 +++++++++-- 5 files changed, 85 insertions(+), 19 deletions(-) diff --git a/v7/src/runtime/chrset.scm b/v7/src/runtime/chrset.scm index ccd5f23ad..b88ca3cd6 100644 --- 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 086a16313..8010ef1d0 100644 --- 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 c1c3dd510..aaa4ca414 100644 --- 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)) - + (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))) - + (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))))))) - + (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))))) ;;;; Output Operations diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index f99123eb0..9090478e7 100644 --- 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 93bd7227a..2b98b4796 100644 --- 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)) -- 2.25.1