[Git][cmucl/cmucl][issue-323-cl-string-casing] Remove old versions of {n}string-{upcase,downcase} - cmucl-cvs - mailman3.common-lisp.net

31 May 2024


      Raymond Toy pushed to branch issue-323-cl-string-casing at cmucl / cmucl
Commits:
483dfe39 by Raymond Toy at 2024-05-31T11:18:35-07:00
Remove old versions of {n}string-{upcase,downcase}
Don&#39;t need these anymore.
- - - - -
1 changed file:
- src/code/string.lisp
Changes:
=====================================
src/code/string.lisp
=====================================
@@ -618,49 +618,6 @@
    (setf (schar string i) fill-char))
       (make-string count)))
-#+nil
-(defun string-upcase (string &key (start 0) end)
-  _N"Given a string, returns a new string that is a copy of it with all
-  lower case alphabetic characters converted to uppercase."
-  (declare (fixnum start))
-  (let* ((string (if (stringp string) string (string string)))
-	 (slen (length string)))
-    (declare (fixnum slen))
-    (with-one-string string start end offset
-      (let ((offset-slen (+ slen offset))
-	    (newstring (make-string slen)))
-	(declare (fixnum offset-slen))
-	(do ((index offset (1+ index))
-	     (new-index 0 (1+ new-index)))
-	    ((= index start))
-	  (declare (fixnum index new-index))
-	  (setf (schar newstring new-index) (schar string index)))
-	(do ((index start (1+ index))
-	     (new-index (- start offset) (1+ new-index)))
-	    ((= index (the fixnum end)))
-	  (declare (fixnum index new-index))
-	  (multiple-value-bind (code wide) (codepoint string index)
-	    (when wide (incf index))
-            ;; Use char-upcase if it's not a surrogate pair so that
-            ;; we're always consist.
-            (if wide
-                (setq code (unicode-upper code))
-                (setf code (char-code (char-upcase (code-char code)))))
-	    ;;@@ WARNING: this may, in theory, need to extend newstring
-	    ;;  but that never actually occurs as of Unicode 5.1.0,
-	    ;;  so I'm just going to ignore it for now...
-	    (multiple-value-bind (hi lo) (surrogates code)
-	      (setf (schar newstring new-index) hi)
-	      (when lo
-		(setf (schar newstring (incf new-index)) lo)))))
-	;;@@ WARNING: see above
-	(do ((index end (1+ index))
-	     (new-index (- (the fixnum end) offset) (1+ new-index)))
-	    ((= index offset-slen))
-	  (declare (fixnum index new-index))
-	  (setf (schar newstring new-index) (schar string index)))
-	newstring))))
-
 (defun string-upcase (string &key (start 0) end)
   _N"Given a string, returns a new string that is a copy of it with all
   lower case alphabetic characters converted to uppercase."
@@ -690,49 +647,6 @@
      (setf (schar newstring new-index) (schar string index)))
         newstring))))
-#+nil
-(defun string-downcase (string &key (start 0) end)
-  _N"Given a string, returns a new string that is a copy of it with all
-  upper case alphabetic characters converted to lowercase."
-  (declare (fixnum start))
-  (let* ((string (if (stringp string) string (string string)))
-	 (slen (length string)))
-    (declare (fixnum slen))
-    (with-one-string string start end offset
-      (let ((offset-slen (+ slen offset))
-	    (newstring (make-string slen)))
-	(declare (fixnum offset-slen))
-	(do ((index offset (1+ index))
-	     (new-index 0 (1+ new-index)))
-	    ((= index start))
-	  (declare (fixnum index new-index))
-	  (setf (schar newstring new-index) (schar string index)))
-	(do ((index start (1+ index))
-	     (new-index (- start offset) (1+ new-index)))
-	    ((= index (the fixnum end)))
-	  (declare (fixnum index new-index))
-	  (multiple-value-bind (code wide) (codepoint string index)
-	    (when wide (incf index))
-            ;; Use char-downcase if it's not a surrogate pair so that
-            ;; we're always consist.
-            (if wide
-                (setq code (unicode-lower code))
-                (setq code (char-code (char-downcase (code-char code)))))
-	    ;;@@ WARNING: this may, in theory, need to extend newstring
-	    ;;  but that never actually occurs as of Unicode 5.1.0,
-	    ;;  so I'm just going to ignore it for now...
-	    (multiple-value-bind (hi lo) (surrogates code)
-	      (setf (schar newstring new-index) hi)
-	      (when lo
-		(setf (schar newstring (incf new-index)) lo)))))
-	;;@@ WARNING: see above
-	(do ((index end (1+ index))
-	     (new-index (- (the fixnum end) offset) (1+ new-index)))
-	    ((= index offset-slen))
-	  (declare (fixnum index new-index))
-	  (setf (schar newstring new-index) (schar string index)))
-	newstring))))
-
 (defun string-downcase (string &key (start 0) end)
   _N"Given a string, returns a new string that is a copy of it with all
   upper case alphabetic characters converted to lowercase."
@@ -804,31 +718,6 @@
      (setf (schar newstring new-index) (schar string index)))
    newstring))))
-#+nil
-(defun nstring-upcase (string &key (start 0) end)
-  "Given a string, returns that string with all lower case alphabetic
-  characters converted to uppercase."
-  (declare (fixnum start))
-  (let ((save-header string))
-    (with-one-string string start end offset
-      (do ((index start (1+ index)))
-	  ((= index (the fixnum end)))
-	(declare (fixnum index))
-	(multiple-value-bind (code wide) (codepoint string index)
-          (if wide
-              (setq code (unicode-upper code))
-              (setf code (char-code (char-upcase (code-char code)))))
-	  ;;@@ WARNING: this may, in theory, need to extend string
-	  ;;      (which, obviously, we can't do here.  Unless
-	  ;;       STRING is adjustable, maybe)
-	  ;;  but that never actually occurs as of Unicode 5.1.0,
-	  ;;  so I'm just going to ignore it for now...
-	  (multiple-value-bind (hi lo) (surrogates code)
-	    (setf (schar string index) hi)
-	    (when lo
-	      (setf (schar string (incf index)) lo))))))
-    save-header))
-
 (defun nstring-upcase (string &key (start 0) end)
   "Given a string, returns that string with all lower case alphabetic
   characters converted to uppercase."
@@ -842,31 +731,6 @@
               (char-upcase (schar string index))))
     save-header)))
-#+nil
-(defun nstring-downcase (string &key (start 0) end)
-  "Given a string, returns that string with all upper case alphabetic
-  characters converted to lowercase."
-  (declare (fixnum start))
-  (let ((save-header string))
-    (with-one-string string start end offset
-      (do ((index start (1+ index)))
-	  ((= index (the fixnum end)))
-	(declare (fixnum index))
-	(multiple-value-bind (code wide) (codepoint string index)
-          (if wide
-              (setq code (unicode-lower code))
-              (setf code (char-code (char-downcase (code-char code)))))
-	  ;;@@ WARNING: this may, in theory, need to extend string
-	  ;;      (which, obviously, we can't do here.  Unless
-	  ;;       STRING is adjustable, maybe)
-	  ;;  but that never actually occurs as of Unicode 5.1.0,
-	  ;;  so I'm just going to ignore it for now...
-	  (multiple-value-bind (hi lo) (surrogates code)
-	    (setf (schar string index) hi)
-	    (when lo
-	      (setf (schar string (incf index)) lo))))))
-    save-header))
-
 (defun nstring-downcase (string &key (start 0) end)
   "Given a string, returns that string with all upper case alphabetic
   characters converted to lowercase."
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/483dfe3999bd7db0cee36ef5...
-- 
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/483dfe3999bd7db0cee36ef5...
You're receiving this email because of your account on gitlab.common-lisp.net.





    