From 3b0a4b5c9054be7dae29cde619f2e77541f81f7e Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 23 Jul 2008 11:12:34 +0000 Subject: [PATCH] Eliminate explicit operations on wide and external strings (part 1): remove INPUT-PORT/READ-{WIDE,EXTERNAL}-SUBSTRING! and OUTPUT-PORT/WRITE-{WIDE,EXTERNAL}-SUBSTRING. (Part 2 will push this multiplexing down into the port operations themselves.) --- v7/src/edwin/fileio.scm | 15 +++------ v7/src/runtime/input.scm | 55 ++++++++------------------------ v7/src/runtime/output.scm | 47 ++++++--------------------- v7/src/runtime/parser-buffer.scm | 6 ++-- v7/src/runtime/runtime.pkg | 10 +----- v7/src/runtime/syncproc.scm | 14 ++++---- 6 files changed, 39 insertions(+), 108 deletions(-) diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm index 0753c1683..4e3012a71 100644 --- a/v7/src/edwin/fileio.scm +++ b/v7/src/edwin/fileio.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: fileio.scm,v 1.173 2008/01/30 20:02:01 cph Exp $ +$Id: fileio.scm,v 1.174 2008/07/23 11:12:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -232,11 +232,7 @@ of the predicates is satisfied, the file is written in the usual way." (end (fix:+ start length))) (let loop ((i start)) (if (fix:< i end) - (let ((n - (input-port/read-external-substring! port - text - i - end))) + (let ((n (input-port/read-substring! port text i end))) (if (fix:> n 0) (loop (fix:+ i n)) (fix:- i start))) @@ -707,10 +703,9 @@ Otherwise, a message is written both before and after long file writes." (group-write-to-port group start end port)))) (define (group-write-to-port group start end port) - (%group-write - group start end - (lambda (string start end) - (output-port/write-external-substring port string start end)))) + (%group-write group start end + (lambda (string start end) + (output-port/write-substring port string start end)))) (define (%group-write group start end writer) (let ((text (group-text group)) diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm index 7cf9c1584..e8fff0d84 100644 --- a/v7/src/runtime/input.scm +++ b/v7/src/runtime/input.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: input.scm,v 14.39 2008/01/30 20:02:31 cph Exp $ +$Id: input.scm,v 14.40 2008/07/23 11:12:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -45,31 +45,19 @@ USA. ((port/operation/peek-char port) port)) (define (input-port/read-string! port string) - (input-port/read-substring! port string 0 (string-length string))) + (input-port/read-substring! port string 0 (xstring-length string))) (define (input-port/read-substring! port string start end) - (if (fix:< start end) - ((port/operation/read-substring port) port string start end) - 0)) - -(define (input-port/read-wide-string! port string) - (input-port/read-wide-substring! port string 0 (wide-string-length string))) - -(define (input-port/read-wide-substring! port string start end) - (if (fix:< start end) - ((port/operation/read-wide-substring port) port string start end) - 0)) - -(define (input-port/read-external-string! port string) - (input-port/read-external-substring! - port - string - 0 - (external-string-length string))) - -(define (input-port/read-external-substring! port string start end) (if (< start end) - ((port/operation/read-external-substring port) port string start end) + ((cond ((string? string) + (port/operation/read-substring port)) + ((wide-string? string) + (port/operation/read-wide-substring port)) + ((external-string? string) + (port/operation/read-external-substring port)) + (else + (error:not-string string 'INPUT-PORT/READ-SUBSTRING!))) + port string start end) 0)) (define (input-port/read-line port) @@ -209,26 +197,11 @@ USA. (input-port/read-line (optional-input-port port 'READ-LINE))) (define (read-string! string #!optional port) - (let ((port (optional-input-port port 'READ-STRING!))) - (cond ((string? string) - (input-port/read-string! port string)) - ((wide-string? string) - (input-port/read-wide-string! port string)) - ((external-string? string) - (input-port/read-external-string! port string)) - (else - (error:wrong-type-argument string "string" 'READ-STRING!))))) + (input-port/read-string! (optional-input-port port 'READ-STRING!) string)) (define (read-substring! string start end #!optional port) - (let ((port (optional-input-port port 'READ-STRING!))) - (cond ((string? string) - (input-port/read-substring! port string start end)) - ((wide-string? string) - (input-port/read-wide-substring! port string start end)) - ((external-string? string) - (input-port/read-external-substring! port string start end)) - (else - (error:wrong-type-argument string "string" 'READ-SUBSTRING!))))) + (input-port/read-substring! (optional-input-port port 'READ-SUBSTRING!) + string start end)) (define (optional-input-port port caller) (if (default-object? port) diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm index e85d91877..dbb282fb5 100644 --- a/v7/src/runtime/output.scm +++ b/v7/src/runtime/output.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: output.scm,v 14.41 2008/07/19 01:41:16 cph Exp $ +$Id: output.scm,v 14.42 2008/07/23 11:12:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -36,23 +36,15 @@ USA. ((port/operation/write-char port) port char)) (define (output-port/write-string port string) - (output-port/write-substring port string 0 (string-length string))) + (output-port/write-substring port string 0 (xstring-length string))) (define (output-port/write-substring port string start end) - ((port/operation/write-substring port) port string start end)) - -(define (output-port/write-wide-string port string) - (output-port/write-wide-substring port string 0 (wide-string-length string))) - -(define (output-port/write-wide-substring port string start end) - ((port/operation/write-wide-substring port) port string start end)) - -(define (output-port/write-external-string port string) - (output-port/write-external-substring port string 0 - (external-string-length string))) - -(define (output-port/write-external-substring port string start end) - ((port/operation/write-external-substring port) port string start end)) + ((cond ((string? string) (port/operation/write-substring port)) + ((wide-string? string) (port/operation/write-wide-substring port)) + ((external-string? string) + (port/operation/write-external-substring port)) + (else (error:not-string string 'OUTPUT-PORT/WRITE-SUBSTRING))) + port string start end)) (define (output-port/fresh-line port) ((port/operation/fresh-line port) port)) @@ -101,33 +93,14 @@ USA. (define (write-string string #!optional port) (let ((port (optional-output-port port 'WRITE-STRING))) - (if (let ((n - (cond ((string? string) - (output-port/write-string port string)) - ((wide-string? string) - (output-port/write-wide-string port string)) - ((external-string? string) - (output-port/write-external-string port string)) - (else - (error:wrong-type-argument string "string" - 'WRITE-STRING))))) + (if (let ((n (output-port/write-string port string))) (and n (> n 0))) (output-port/discretionary-flush port)))) (define (write-substring string start end #!optional port) (let ((port (optional-output-port port 'WRITE-SUBSTRING))) - (if (let ((n - (cond ((string? string) - (output-port/write-substring port string start end)) - ((wide-string? string) - (output-port/write-wide-substring port string start end)) - ((external-string? string) - (output-port/write-external-substring port - string start end)) - (else - (error:wrong-type-argument string "string" - 'WRITE-SUBSTRING))))) + (if (let ((n (output-port/write-substring port string start end))) (and n (> n 0))) (output-port/discretionary-flush port)))) diff --git a/v7/src/runtime/parser-buffer.scm b/v7/src/runtime/parser-buffer.scm index ac3f5798e..225fe0af1 100644 --- a/v7/src/runtime/parser-buffer.scm +++ b/v7/src/runtime/parser-buffer.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: parser-buffer.scm,v 1.21 2008/01/30 20:02:33 cph Exp $ +$Id: parser-buffer.scm,v 1.22 2008/07/23 11:12:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -422,8 +422,8 @@ USA. (let loop ((end end)) (if (fix:< end min-end) (let ((n-read - (input-port/read-wide-substring! - port string end min-end))) + (input-port/read-substring! port + string end min-end))) (if (fix:> n-read 0) (let ((end (fix:+ end n-read))) (set-parser-buffer-end! buffer end) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index ce9f33ccd..ed83e2873 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.649 2008/07/19 01:41:16 cph Exp $ +$Id: runtime.pkg,v 14.650 2008/07/23 11:12:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -2055,14 +2055,10 @@ USA. input-port/eof? input-port/peek-char input-port/read-char - input-port/read-external-string! - input-port/read-external-substring! input-port/read-line input-port/read-string input-port/read-string! input-port/read-substring! - input-port/read-wide-string! - input-port/read-wide-substring! input-port/unread-char make-eof-object peek-char @@ -2095,12 +2091,8 @@ USA. output-port/line-start? output-port/write-char output-port/write-object - output-port/write-external-string - output-port/write-external-substring output-port/write-string output-port/write-substring - output-port/write-wide-string - output-port/write-wide-substring output-port/x-size output-port/y-size write diff --git a/v7/src/runtime/syncproc.scm b/v7/src/runtime/syncproc.scm index 01971d50a..96b22a193 100644 --- a/v7/src/runtime/syncproc.scm +++ b/v7/src/runtime/syncproc.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: syncproc.scm,v 1.14 2008/01/30 20:02:35 cph Exp $ +$Id: syncproc.scm,v 1.15 2008/07/23 11:12:34 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -209,12 +209,10 @@ USA. (port/with-input-blocking-mode process-input 'BLOCKING (lambda () (let ((n - (input-port/read-wide-string! process-input - buffer))) + (input-port/read-string! process-input buffer))) (if n (if (fix:> n 0) - (output-port/write-wide-substring port - buffer 0 n) + (output-port/write-substring port buffer 0 n) (output-port/close port))) n)))))))) (begin @@ -246,13 +244,13 @@ USA. (let ((buffer (make-wide-string bsize))) (let ((copy-output (lambda () - (let ((n (input-port/read-wide-string! port buffer))) + (let ((n (input-port/read-string! port buffer))) (if (and n (fix:> n 0)) (port/with-output-blocking-mode process-output 'BLOCKING (lambda () - (output-port/write-wide-substring - process-output buffer 0 n)))) + (output-port/write-substring process-output + buffer 0 n)))) n)))) (if nonblock? (port/set-input-blocking-mode port 'NONBLOCKING)) (let ((status (receiver copy-output))) -- 2.25.1