Eliminate a bunch of operations that modify strings in place.

These generally save a little memory but are difficult to implement with Unicode
strings.  It's not worth the trouble to keep them since the copying procedures
can be used instead.

diff --git a/src/edwin/dosfile.scm b/src/edwin/dosfile.scm
index 536ce583f5f91170df7c2498d5416313c024d7b0..64057c46bab5d335a5631fcf07943aae93fe6c05 100644 (file)
--- a/src/edwin/dosfile.scm
+++ b/src/edwin/dosfile.scm
@@ -113,7 +113,7 @@ Includes the new backup.  Must be > 0."
     (let loop ((result '()))
       (let ((name (directory-channel-read channel)))
        (if name
-           (loop (cons (begin (string-downcase! name) name) result))
+           (loop (cons (string-downcase name) result))
            (begin
              (directory-channel-close channel)
              result))))))
@@ -123,7 +123,7 @@ Includes the new backup.  Must be > 0."
     (let loop ((result '()))
       (let ((name (directory-channel-read-matching channel prefix)))
        (if name
-           (loop (cons (begin (string-downcase! name) name) result))
+           (loop (cons (string-downcase name) result))
            (begin
              (directory-channel-close channel)
              result))))))

diff --git a/src/edwin/info.scm b/src/edwin/info.scm
index 4d52ae07125c8a47ce6b644225b65990970dfe2b..5aac3fb871ee8179cc6b3073736c57f337515581 100644 (file)
--- a/src/edwin/info.scm
+++ b/src/edwin/info.scm
@@ -649,9 +649,7 @@ The name may be an abbreviation of the reference name."
     (%cref-item-keyword item (mark-1+ colon))))
 
 (define (%cref-item-keyword item colon)
-  (let ((string (extract-string item colon)))
-    (string-replace! string #\newline #\Space)
-    (string-trim string)))
+  (string-trim (string-replace (extract-string item colon) #\newline #\space)))
 
 (define (cref-item-name item)
   (let ((colon (char-search-forward #\: item (group-end item) false)))

diff --git a/src/edwin/sendmail.scm b/src/edwin/sendmail.scm
index 3dbdafbb628e306acdfedb8a8285aaab2ad4c2af..49ae7b36c482cf83276d3828784d5dd8bf6a3594 100644 (file)
--- a/src/edwin/sendmail.scm
+++ b/src/edwin/sendmail.scm
@@ -1583,15 +1583,15 @@ the user from the mailer."
         (plen (string-length prefix)))
     (if (not (<= 1 length (- 70 plen)))
        (error:bad-range-argument length 'RANDOM-MIME-BOUNDARY-STRING))
-    (string-head! (call-with-output-string
-                   (lambda (port)
-                     (write-string prefix port)
-                     (let ((context (encode-base64:initialize port #f)))
-                       (let ((n (* (integer-ceiling (- length 2) 4) 3)))
-                         (encode-base64:update context
-                                               (random-byte-vector n) 0 n))
-                       (encode-base64:finalize context))))
-                 (+ plen length))))
+    (string-head (call-with-output-string
+                  (lambda (port)
+                    (write-string prefix port)
+                    (let ((context (encode-base64:initialize port #f)))
+                      (let ((n (* (integer-ceiling (- length 2) 4) 3)))
+                        (encode-base64:update context
+                                              (random-byte-vector n) 0 n))
+                      (encode-base64:finalize context))))
+                (+ plen length))))
 \f
 ;;;; Attachment browser
 

diff --git a/src/edwin/texcom.scm b/src/edwin/texcom.scm
index e090fd428272b1b104561d9d47cea2cd172abc41..9c3d532c164f5a31fbd2123e8763c380cef8c1de 100644 (file)
--- a/src/edwin/texcom.scm
+++ b/src/edwin/texcom.scm
@@ -183,16 +183,10 @@ With negative argument, capitalize previous words but do not move."
     (if (positive? argument) (set-current-point! end))))
 
 (define (downcase-region region)
-  (region-transform! region
-    (lambda (string)
-      (string-downcase! string)
-      string)))
+  (region-transform! region string-downcase))
 
 (define (upcase-region region)
-  (region-transform! region
-    (lambda (string)
-      (string-upcase! string)
-      string)))
+  (region-transform! region string-upcase))
 
 (define (capitalize-region region)
   (let ((end (region-end region)))
@@ -203,14 +197,10 @@ With negative argument, capitalize previous words but do not move."
              (if m
                  (begin
                    (region-transform! (make-region start m)
-                     (lambda (string)
-                       (string-capitalize! string)
-                       string))
+                                      string-capitalize)
                    (loop m))
                  (region-transform! (make-region start end)
-                   (lambda (string)
-                     (string-capitalize! string)
-                     string)))))))))
+                                    string-capitalize))))))))
 \f
 ;;;; Sentences
 

diff --git a/src/imail/imail-imap.scm b/src/imail/imail-imap.scm
index 78023c6b88ca1e05fedb954e09bf82f717592811..9690df2e5cab6faf437b48328fd39def93ab0558 100644 (file)
--- a/src/imail/imail-imap.scm
+++ b/src/imail/imail-imap.scm
@@ -139,9 +139,7 @@ USA.
   (cond ((string-ci=? "inbox" mailbox) "inbox")
        ((and (string-prefix-ci? "inbox/" mailbox)
              (not (string-prefix? "inbox/" mailbox)))
-        (let ((mailbox (string-copy mailbox)))
-          (substring-downcase! mailbox 0 5)
-          mailbox))
+        (substring-downcase mailbox 0 5))
        (else mailbox)))
 
 (define (compatible-imap-urls? url1 url2)

diff --git a/src/runtime/input.scm b/src/runtime/input.scm
index b78e538c258cb2d7c02b70ec31cd5d635654895b..ba4dd8de80a5b7ec49e552e454546da5ad6eeca3 100644 (file)
--- a/src/runtime/input.scm
+++ b/src/runtime/input.scm
@@ -107,7 +107,7 @@ USA.
   a)
 
 (define-integrable (accum->string a)
-  (string-head! (car a) (cdr a)))
+  (string-head (car a) (cdr a)))
 
 (define-integrable (accum-count a)
   (cdr a))

diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm
index 072d67843abfb07b35c1c6b9c7fed1f3203421af..d177dd07cfbbd070a9e0c51b0ca137a390e260ea 100644 (file)
--- a/src/runtime/pgsql.scm
+++ b/src/runtime/pgsql.scm
@@ -300,7 +300,7 @@ USA.
 (define (escape-pgsql-string string)
   (guarantee-pgsql-available)
   (let ((escaped (make-string (fix:* 2 (string-length string)))))
-    (string-head! escaped (pq-escape-string string escaped))))
+    (string-head escaped (pq-escape-string string escaped))))
 
 (define (encode-pgsql-bytea bytes)
   (guarantee-pgsql-available)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 5e790b85f8224d8de8008399b4edd973c8598813..1b06a39499902ecfa9c37f1ccde1d48b1b2f7e7e 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1049,18 +1049,13 @@ USA.
          lisp-string->camel-case
          make-string
          reverse-string
-         reverse-string!
          reverse-substring
-         reverse-substring!
          set-string-length!
          string-allocate
          string-capitalize
-         string-capitalize!
          string-capitalized?
          string-compare
          string-compare-ci
-         string-downcase!
-         string-head!
          string-match-backward
          string-match-backward-ci
          string-match-forward
@@ -1069,27 +1064,21 @@ USA.
          string-pad-left
          string-pad-right
          string-replace
-         string-replace!
          string-search-all
          string-search-backward
          string-search-forward
          string-trim
          string-trim-left
          string-trim-right
-         string-upcase!
-         substring-capitalize!
          substring-capitalized?
-         substring-downcase!
          substring-match-backward
          substring-match-backward-ci
          substring-match-forward
          substring-match-forward-ci
          substring-replace
-         substring-replace!
          substring-search-all
          substring-search-backward
          substring-search-forward
-         substring-upcase!
          substring?)
   (initialization (initialize-package!)))
 

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index 3e0ac7a8725aee1210f28f8cb79535fd6289c1eb..0baf081d0cfef8cfe0f1082cdddb08518422bbdf 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -81,43 +81,6 @@ USA.
     (let ((result (string-allocate size)))
       (and (%ascii-substring-move! string 0 size result 0)
           result))))
-\f
-(define (string-head! string end)
-  (declare (no-type-checks) (no-range-checks))
-  (guarantee-string string 'STRING-HEAD!)
-  (guarantee-substring-end-index end (string-length string) 'STRING-HEAD!)
-  (%string-head! string end))
-
-(define %string-head!
-  (let ((reuse
-        (named-lambda (%string-head! string end)
-          (declare (no-type-checks) (no-range-checks))
-          (let ((mask (set-interrupt-enables! interrupt-mask/none)))
-            (if (fix:< end (string-length string))
-                (begin
-                  (string-set! string end #\nul)
-                  (set-string-length! string end)))
-            (let ((new-gc-length (fix:+ 2 (fix:lsh end %octets->words-shift)))
-                  (old-gc-length (system-vector-length string)))
-              (let ((delta (fix:- old-gc-length new-gc-length)))
-                (cond ((fix:= delta 1)
-                       (system-vector-set! string new-gc-length #f))
-                      ((fix:> delta 1)
-                       (system-vector-set!
-                        string new-gc-length
-                        ((ucode-primitive primitive-object-set-type 2)
-                         (ucode-type manifest-nm-vector) (fix:-1+ delta)))))
-                (if (fix:> delta 0)
-                    ((ucode-primitive primitive-object-set! 3)
-                     string
-                     0
-                     ((ucode-primitive primitive-object-set-type 2)
-                      (ucode-type manifest-nm-vector) new-gc-length)))))
-            (set-interrupt-enables! mask)
-            string))))
-    (if (compiled-procedure? reuse)
-       reuse
-       string-head)))
 
 (define (string-maximum-length string)
   (guarantee-string string 'STRING-MAXIMUM-LENGTH)
@@ -236,23 +199,6 @@ USA.
          ((fix:= i end))
        (string-set! result j (string-ref string i)))
       result)))
-
-(define (reverse-string! string)
-  (guarantee-string string 'REVERSE-STRING!)
-  (%reverse-substring! string 0 (string-length string)))
-
-(define (reverse-substring! string start end)
-  (guarantee-substring string start end 'REVERSE-SUBSTRING!)
-  (%reverse-substring! string start end))
-
-(define (%reverse-substring! string start end)
-  (let ((k (fix:+ start (fix:quotient (fix:- end start) 2))))
-    (do ((i start (fix:+ i 1))
-        (j (fix:- end 1) (fix:- j 1)))
-       ((fix:= i k))
-      (let ((char (string-ref string j)))
-       (string-set! string j (string-ref string i))
-       (string-set! string i char)))))
 \f
 (define (vector-8b->hexadecimal bytes)
   (define-integrable (hex-char k)
@@ -298,32 +244,6 @@ USA.
 \f
 ;;;; Case
 
-(define (string-upcase! string)
-  (guarantee-string string 'STRING-UPCASE!)
-  (%substring-upcase! string 0 (string-length string)))
-
-(define (substring-upcase! string start end)
-  (guarantee-substring string start end 'SUBSTRING-UPCASE!)
-  (%substring-upcase! string start end))
-
-(define (%substring-upcase! string start end)
-  (do ((i start (fix:+ i 1)))
-      ((fix:= i end))
-    (string-set! string i (char-upcase (string-ref string i)))))
-
-(define (string-downcase! string)
-  (guarantee-string string 'STRING-DOWNCASE!)
-  (substring-downcase! string 0 (string-length string)))
-
-(define (substring-downcase! string start end)
-  (guarantee-substring string start end 'SUBSTRING-DOWNCASE!)
-  (%substring-downcase! string start end))
-
-(define (%substring-downcase! string start end)
-  (do ((i start (fix:+ i 1)))
-      ((fix:= i end))
-    (string-set! string i (char-downcase (string-ref string i)))))
-
 (define (string-capitalized? string)
   (guarantee-string string 'STRING-CAPITALIZED?)
   (substring-capitalized? string 0 (string-length string)))
@@ -371,14 +291,6 @@ USA.
     (%substring-capitalize! string 0 (string-length string))
     string))
 
-(define (string-capitalize! string)
-  (guarantee-string string 'STRING-CAPITALIZE!)
-  (%substring-capitalize! string 0 (string-length string)))
-
-(define (substring-capitalize! string start end)
-  (guarantee-substring string start end 'SUBSTRING-CAPITALIZE!)
-  (%substring-capitalize! string start end))
-
 (define (%substring-capitalize! string start end)
   ;; This algorithm capitalizes the first word in the substring and
   ;; downcases the subsequent words.  This is arbitrary, but seems
@@ -391,6 +303,16 @@ USA.
        (begin
          (%substring-upcase! string index (fix:+ index 1))
          (%substring-downcase! string (fix:+ index 1) end)))))
+
+(define (%substring-upcase! string start end)
+  (do ((i start (fix:+ i 1)))
+      ((fix:= i end))
+    (string-set! string i (char-upcase (string-ref string i)))))
+
+(define (%substring-downcase! string start end)
+  (do ((i start (fix:+ i 1)))
+      ((fix:= i end))
+    (string-set! string i (char-downcase (string-ref string i)))))
 \f
 ;;;; CamelCase support
 
@@ -448,18 +370,6 @@ USA.
     (%substring-replace! string start end char1 char2)
     string))
 
-(define (string-replace! string char1 char2)
-  (guarantee-string string 'STRING-REPLACE!)
-  (guarantee-char char1 'STRING-REPLACE!)
-  (guarantee-char char2 'STRING-REPLACE!)
-  (%substring-replace! string 0 (string-length string) char1 char2))
-
-(define (substring-replace! string start end char1 char2)
-  (guarantee-substring string start end 'SUBSTRING-REPLACE!)
-  (guarantee-char char1 'SUBSTRING-REPLACE!)
-  (guarantee-char char2 'SUBSTRING-REPLACE!)
-  (%substring-replace! string start end char1 char2))
-
 (define (%substring-replace! string start end char1 char2)
   (let loop ((start start))
     (let ((index (substring-find-next-char string start end char1)))

diff --git a/src/runtime/stringio.scm b/src/runtime/stringio.scm
index dec3849039adea885c14ece1fb1cfd13018a82a8..d6faebe04aee933821a3bc5440295ba9a8ae7bd2 100644 (file)
--- a/src/runtime/stringio.scm
+++ b/src/runtime/stringio.scm
@@ -335,7 +335,7 @@ USA.
 (define (octets-out/extract-output! port)
   (output-port/flush-output port)
   (let* ((os (output-octets-port/os port))
-        (output (string-head! (ostate-buffer os) (ostate-index os))))
+        (output (string-head (ostate-buffer os) (ostate-index os))))
     (set-ostate-buffer! os (make-vector-8b 16))
     (set-ostate-index! os 0)
     output))