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.)

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 0753c1683aea0b4773fbb0888d57febeef4cbe3e..4e3012a715a5044904422548fc6669d0ffe339c9 100644 (file)
--- 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 7cf9c1584b00786633604b9778dea03993f6297f..e8fff0d8468a7a38e3b333cd5b48201c77b20006 100644 (file)
--- 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))
 \f
 (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 e85d91877be05c1b8ce5590beae8c69a46b578ee..dbb282fb5dedab9d1da87615bea027782a8a0836 100644 (file)
--- 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 ac3f5798e3d3c946601e85596f8153b71871666a..225fe0af1ff67df6affb88cfdc8d27a1e9dc79a5 100644 (file)
--- 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 ce9f33ccdebe2ce24676b821ee697c0132623dc6..ed83e2873fbd4ff915a5044fd77fe4d6e319bbc4 100644 (file)
--- 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 01971d50a87a0908912fec634475d1d772f6a640..96b22a19369e449639276eb3083c1c7b2427ed47 100644 (file)
--- 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)))