From 080b1a4fe9f672d65b0c7c7bd8ac530a6060172b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 16 Feb 1999 00:53:21 +0000 Subject: [PATCH] Eliminate WRITE-STRING output-port operation. --- v7/src/runtime/fileio.scm | 3 +-- v7/src/runtime/genio.scm | 6 +----- v7/src/runtime/output.scm | 4 ++-- v7/src/runtime/port.scm | 16 ++-------------- v7/src/runtime/runtime.pkg | 4 +--- v7/src/runtime/strott.scm | 25 +++++++++++++------------ v8/src/runtime/runtime.pkg | 4 +--- 7 files changed, 21 insertions(+), 41 deletions(-) diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm index 408bc8f83..4437a9683 100644 --- a/v7/src/runtime/fileio.scm +++ b/v7/src/runtime/fileio.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: fileio.scm,v 1.13 1999/02/16 00:40:59 cph Exp $ +$Id: fileio.scm,v 1.14 1999/02/16 00:49:52 cph Exp $ Copyright (c) 1991-1999 Massachusetts Institute of Technology @@ -60,7 +60,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (SET-OUTPUT-BUFFER-SIZE ,operation/set-output-buffer-size) (SET-OUTPUT-TERMINAL-MODE ,operation/set-output-terminal-mode) (WRITE-CHAR ,operation/write-char) - (WRITE-STRING ,operation/write-string) (WRITE-SUBSTRING ,operation/write-substring))) (other-operations `((CLOSE ,operation/close) diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm index 87918d67a..9f1a818e2 100644 --- a/v7/src/runtime/genio.scm +++ b/v7/src/runtime/genio.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: genio.scm,v 1.10 1999/02/16 00:41:03 cph Exp $ +$Id: genio.scm,v 1.11 1999/02/16 00:50:04 cph Exp $ Copyright (c) 1991-1999 Massachusetts Institute of Technology @@ -58,7 +58,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (SET-OUTPUT-BUFFER-SIZE ,operation/set-output-buffer-size) (SET-OUTPUT-TERMINAL-MODE ,operation/set-output-terminal-mode) (WRITE-CHAR ,operation/write-char) - (WRITE-STRING ,operation/write-string) (WRITE-SUBSTRING ,operation/write-substring))) (other-operations `((CLOSE ,operation/close) @@ -224,9 +223,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (operation/write-char port char) (output-buffer/write-char-block (port/output-buffer port) char)) -(define (operation/write-string port string) - (output-buffer/write-string-block (port/output-buffer port) string)) - (define (operation/write-substring port string start end) (output-buffer/write-substring-block (port/output-buffer port) string start end)) diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm index a4e7e4a35..db96ce65f 100644 --- a/v7/src/runtime/output.scm +++ b/v7/src/runtime/output.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: output.scm,v 14.17 1999/01/02 06:11:34 cph Exp $ +$Id: output.scm,v 14.18 1999/02/16 00:49:02 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -30,7 +30,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ((output-port/operation/write-char port) port char)) (define (output-port/write-string port string) - ((output-port/operation/write-string port) port string)) + (output-port/write-substring port string 0 (string-length string))) (define (output-port/write-substring port string start end) ((output-port/operation/write-substring port) port string start end)) diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm index 4d44c846b..b5fc7644a 100644 --- a/v7/src/runtime/port.scm +++ b/v7/src/runtime/port.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: port.scm,v 1.11 1999/01/02 06:11:34 cph Exp $ +$Id: port.scm,v 1.12 1999/02/16 00:49:21 cph Exp $ Copyright (c) 1991-1999 Massachusetts Institute of Technology @@ -40,7 +40,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. READ-SUBSTRING ;; output operations: WRITE-CHAR - WRITE-STRING WRITE-SUBSTRING FLUSH-OUTPUT DISCRETIONARY-FLUSH-OUTPUT))) @@ -78,9 +77,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define output-port/operation/write-char (record-accessor port-rtd 'WRITE-CHAR)) -(define output-port/operation/write-string - (record-accessor port-rtd 'WRITE-STRING)) - (define output-port/operation/write-substring (record-accessor port-rtd 'WRITE-SUBSTRING)) @@ -129,7 +125,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ((DISCARD-CHARS) (input-port/operation/discard-chars port)) ((READ-SUBSTRING) (input-port/operation/read-substring port)) ((WRITE-CHAR) (output-port/operation/write-char port)) - ((WRITE-STRING) (output-port/operation/write-string port)) ((WRITE-SUBSTRING) (output-port/operation/write-substring port)) ((FLUSH-OUTPUT) (output-port/operation/flush-output port)) ((DISCRETIONARY-FLUSH-OUTPUT) @@ -371,11 +366,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (default-operation/write-char port char) ((output-port/operation/write-substring port) port (string char) 0 1)) -(define (default-operation/write-string port string) - ((output-port/operation/write-substring port) - port - string 0 (string-length string))) - (define (default-operation/write-substring port string start end) (let ((write-char (output-port/operation/write-char port))) (let loop ((index start)) @@ -390,12 +380,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define install-output-operations! (let ((operation-names - '(WRITE-CHAR WRITE-SUBSTRING WRITE-STRING - FLUSH-OUTPUT DISCRETIONARY-FLUSH-OUTPUT)) + '(WRITE-CHAR WRITE-SUBSTRING FLUSH-OUTPUT DISCRETIONARY-FLUSH-OUTPUT)) (operation-defaults (list default-operation/write-char default-operation/write-substring - default-operation/write-string default-operation/flush-output default-operation/flush-output))) (let ((updaters diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index e250057fc..7a20ed50c 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.305 1999/02/16 00:40:48 cph Exp $ +$Id: runtime.pkg,v 14.306 1999/02/16 00:49:11 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -961,7 +961,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. operation/set-output-buffer-size operation/set-output-terminal-mode operation/write-char - operation/write-string operation/write-substring) (initialization (initialize-package!))) @@ -1124,7 +1123,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. output-port/operation/discretionary-flush output-port/operation/flush-output output-port/operation/write-char - output-port/operation/write-string output-port/operation/write-substring output-port/state output-port? diff --git a/v7/src/runtime/strott.scm b/v7/src/runtime/strott.scm index 3df72a201..6176aa6e5 100644 --- a/v7/src/runtime/strott.scm +++ b/v7/src/runtime/strott.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: strott.scm,v 14.5 1999/01/02 06:19:10 cph Exp $ +$Id: strott.scm,v 14.6 1999/02/16 00:53:21 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -28,13 +28,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (set! output-string-template (make-output-port `((WRITE-SELF ,operation/write-self) (WRITE-CHAR ,operation/write-char) - (WRITE-STRING ,operation/write-string)) - false))) + (WRITE-SUBSTRING ,operation/write-substring)) + #f))) (define (with-output-to-truncated-string max thunk) (call-with-current-continuation (lambda (return) - (cons false + (cons #f (apply string-append (reverse! (let ((state @@ -48,8 +48,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define-structure (output-string-state (type vector) (conc-name output-string-state/)) - (return false read-only true) - (max-length false read-only true) + (return #f read-only #t) + (max-length #f read-only #t) accumulator counter) @@ -59,21 +59,22 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (counter (output-string-state/counter state))) (if (zero? counter) ((output-string-state/return state) - (cons true (apply string-append (reverse! accumulator)))) + (cons #t (apply string-append (reverse! accumulator)))) (begin (set-output-string-state/accumulator! state (cons (string char) accumulator)) (set-output-string-state/counter! state (-1+ counter))))))) -(define (operation/write-string port string) +(define (operation/write-substring port string start end) (let ((state (output-port/state port))) - (let ((accumulator (cons string (output-string-state/accumulator state))) - (counter - (- (output-string-state/counter state) (string-length string)))) + (let ((accumulator + (cons (substring string start end) + (output-string-state/accumulator state))) + (counter (- (output-string-state/counter state) (- end start)))) (if (negative? counter) ((output-string-state/return state) - (cons true + (cons #t (substring (apply string-append (reverse! accumulator)) 0 (output-string-state/max-length state)))) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 8fba96d36..b92937a70 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.311 1999/02/16 00:40:53 cph Exp $ +$Id: runtime.pkg,v 14.312 1999/02/16 00:49:36 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -965,7 +965,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. operation/set-output-buffer-size operation/set-output-terminal-mode operation/write-char - operation/write-string operation/write-substring) (initialization (initialize-package!))) @@ -1128,7 +1127,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. output-port/operation/discretionary-flush output-port/operation/flush-output output-port/operation/write-char - output-port/operation/write-string output-port/operation/write-substring output-port/state output-port? -- 2.25.1