From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 18 Feb 2017 03:58:14 +0000 (-0800)
Subject: Begin process of replacing string operations with ustring equivalents.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~80
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3dbdfc908d7f08a3c979a976f11faf28f5c1e94a;p=mit-scheme.git

Begin process of replacing string operations with ustring equivalents.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 5603e4933..4f189cec5 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -468,9 +468,9 @@ USA.
   (cond ((not (int:integer? number))
 	 (error:wrong-type-argument number #f 'NUMBER->STRING))
 	((int:negative? number)
-	 (list->string (cons #\- (n>0 (int:negate number)))))
+	 (list->ustring (cons #\- (n>0 (int:negate number)))))
 	(else
-	 (list->string (n>0 number)))))
+	 (list->ustring (n>0 number)))))
 
 (declare (integrate-operator rat:rational?))
 (define (rat:rational? object)
diff --git a/src/runtime/chrset.scm b/src/runtime/chrset.scm
index 9b27294bd..fc4293192 100644
--- a/src/runtime/chrset.scm
+++ b/src/runtime/chrset.scm
@@ -533,7 +533,7 @@ USA.
 
 ;; Returns ASCII string:
 (define (char-set->string char-set)
-  (list->string (char-set-members char-set)))
+  (list->ustring (char-set-members char-set)))
 
 ;; Returns only ASCII members:
 (define (char-set-members char-set)
diff --git a/src/runtime/dragon4.scm b/src/runtime/dragon4.scm
index c09572add..b033a894d 100644
--- a/src/runtime/dragon4.scm
+++ b/src/runtime/dragon4.scm
@@ -80,7 +80,7 @@ not much different to numbers within a few orders of magnitude of 1.
 		     (dragon4 f e p radix cutoff-mode cutoff
 		       (lambda (u k generate)
 			 (let ((digits
-				(list->string
+				(list->ustring
 				 (let loop ((u u) (k k) (generate generate))
 				   k	;ignore
 				   (if (negative? u)
diff --git a/src/runtime/hashtb.scm b/src/runtime/hashtb.scm
index 0eeebc207..dd3b6642a 100644
--- a/src/runtime/hashtb.scm
+++ b/src/runtime/hashtb.scm
@@ -1299,13 +1299,10 @@ USA.
   (make-hash-table-type key-hash
 			key=?
 			(if (and (or (eq? key=? string=?)
-				     (eq? key=? string-ci=?)
-				     (eq? key=? ustring=?))
-				 (or (eq? key-hash string-hash-mod)
-				     (eq? key-hash string-hash)
-				     (eq? key-hash ustring-hash)
-				     (eq? key-hash hash)
-				     (eq? key-hash string-ci-hash)))
+				     (eq? key=? string-ci=?))
+				 (or (eq? key-hash string-hash)
+				     (eq? key-hash string-ci-hash)
+				     (eq? key-hash hash)))
 			    #f		;No rehash needed after GC
 			    #t)		;Rehash needed after GC
 			hash-table-entry-type:strong))
diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm
index 30c69a05e..2f3ab92c5 100644
--- a/src/runtime/rgxcmp.scm
+++ b/src/runtime/rgxcmp.scm
@@ -380,7 +380,7 @@ USA.
 		(if (not (stack-empty? ctx))
 		    (compilation-error ctx "Unmatched \\("))
 		(make-compiled-regexp
-		 (list->string (map integer->char (cdr (output-head ctx))))
+		 (list->ustring (map integer->char (cdr (output-head ctx))))
 		 case-fold?))
 	      (begin
 		(compile-pattern-char ctx)
@@ -695,7 +695,7 @@ USA.
 							  (char->integer char)))
 		 (char-set-members
 		  (re-compile-char-set
-		   (list->string (map integer->char (reverse! chars)))
+		   (list->ustring (map integer->char (reverse! chars)))
 		   #f))))
 	      (loop (cons char chars)))))
       (output-start! ctx (if invert? re-code:not-char-set re-code:char-set))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 50c6df73d..2539d8aee 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1050,7 +1050,7 @@ USA.
 	  guarantee-substring-end-index
 	  guarantee-substring-start-index
 	  lisp-string->camel-case
-	  list->string
+	  ;;list->string
 	  make-string
 	  reverse-string
 	  reverse-string!
@@ -1058,19 +1058,19 @@ USA.
 	  reverse-substring!
 	  set-string-length!
 	  string
-	  string->list
-	  string->vector
+	  ;;string->list
+	  ;;string->vector
 	  string-allocate
 	  string-append
 	  string-capitalize
 	  string-capitalize!
 	  string-capitalized?
-	  string-ci-hash
-	  string-ci<=?
-	  string-ci<?
-	  string-ci=?
-	  string-ci>=?
-	  string-ci>?
+	  ;; string-ci-hash
+	  ;; string-ci<=?
+	  ;; string-ci<?
+	  ;; string-ci=?
+	  ;; string-ci>=?
+	  ;; string-ci>?
 	  string-compare
 	  string-compare-ci
 	  string-copy
@@ -1085,8 +1085,8 @@ USA.
 	  string-find-previous-char-ci
 	  string-find-previous-char-in-set
 	  string-for-each
-	  string-hash
-	  string-hash-mod
+	  ;; string-hash
+	  ;; string-hash-mod
 	  string-head
 	  string-head!
 	  string-joiner
@@ -1122,11 +1122,11 @@ USA.
 	  string-upcase
 	  string-upcase!
 	  string-upper-case?
-	  string<=?
-	  string<?
-	  string=?
-	  string>=?
-	  string>?
+	  ;; string<=?
+	  ;; string<?
+	  ;; string=?
+	  ;; string>=?
+	  ;; string>?
 	  string?
 	  substring
 	  substring->list
@@ -1170,6 +1170,22 @@ USA.
   (files "ustring")
   (parent (runtime))
   (export ()
+	  (list->string list->ustring)
+	  (string->list ustring->list)
+	  (string->vector ustring->vector)
+	  (string-ci-hash ustring-ci-hash)
+	  (string-ci<=? ustring-ci<=?)
+	  (string-ci<? ustring-ci<?)
+	  (string-ci=? ustring-ci=?)
+	  (string-ci>=? ustring-ci>=?)
+	  (string-ci>? ustring-ci>?)
+	  (string-hash ustring-hash)
+	  (string-hash-mod ustring-hash)
+	  (string<=? ustring<=?)
+	  (string<? ustring<?)
+	  (string=? ustring=?)
+	  (string>=? ustring>=?)
+	  (string>? ustring>?)
 	  (usubstring ustring-copy)
 	  list->ustring
 	  make-ustring
@@ -1186,6 +1202,7 @@ USA.
 	  ustring-ci=?
 	  ustring-ci>=?
 	  ustring-ci>?
+	  ustring-ci-hash
 	  ustring-copy
 	  ustring-copy!
 	  ustring-downcase
diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 677f569b4..493e59c5d 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -614,6 +614,9 @@ USA.
 	((ucode-primitive string-hash) string*)
 	((ucode-primitive string-hash-mod) string* modulus))))
 
+(define (ustring-ci-hash string #!optional modulus)
+  (ustring-hash (ustring-foldcase string) modulus))
+
 (define (ustring->legacy-string string)
   (if (legacy-string? string)
       string