From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 5 Dec 2019 06:19:52 +0000 (-0800)
Subject: Eliminate use of char-set-members.
X-Git-Tag: mit-scheme-pucked-10.1.20~10^2~2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f6a3f20e3a49bcfaefc12996ba6d1dadbace1828;p=mit-scheme.git

Eliminate use of char-set-members.
---

diff --git a/src/edwin/comtab.scm b/src/edwin/comtab.scm
index afb7057bc..7f77d4464 100644
--- a/src/edwin/comtab.scm
+++ b/src/edwin/comtab.scm
@@ -296,7 +296,7 @@ USA.
     (cond ((or (key? key) (button? key))
 	   (put! key))
 	  ((char-set? key)
-	   (for-each put! (char-set-members key)))
+	   (char-set-for-each put! (char-set-intersection key char-set:ascii)))
 	  ((prefixed-key? key)
 	   (let ((prefix (except-last-pair key)))
 	     (comtab-put! (if (null? prefix)
diff --git a/src/edwin/paredit.scm b/src/edwin/paredit.scm
index 26fb467ea..d93b450d7 100644
--- a/src/edwin/paredit.scm
+++ b/src/edwin/paredit.scm
@@ -888,7 +888,7 @@ Both must be lists, strings, or atoms; error if there is mismatch."
                       end))
 
 (define (char-set->ascii-string char-set)
-  (list->string (char-set-members char-set)))
+  (char-set->string (char-set-intersection char-set char-set:ascii)))
 
 (define (undo-record-point! #!optional buffer)
   (let ((group (buffer-group (if (default-object? buffer)
diff --git a/src/runtime/chrsyn.scm b/src/runtime/chrsyn.scm
index ece276569..f36c9016c 100644
--- a/src/runtime/chrsyn.scm
+++ b/src/runtime/chrsyn.scm
@@ -55,9 +55,10 @@ USA.
     (cond ((char? char)
 	   (vector-set! entries (char->integer char) entry))
 	  ((char-set? char)
-	   (for-each (lambda (char)
-		       (vector-set! entries (char->integer char) entry))
-		     (char-set-members char)))
+	   (char-set-for-each
+	    (lambda (char)
+	      (vector-set! entries (char->integer char) entry))
+	    (char-set-intersection char char-set:ascii)))
 	  (else
 	   (error:wrong-type-argument char "character" 'set-char-syntax!)))))
 
diff --git a/src/runtime/http-syntax.scm b/src/runtime/http-syntax.scm
index 1f5c834cc..d6c4271d8 100644
--- a/src/runtime/http-syntax.scm
+++ b/src/runtime/http-syntax.scm
@@ -844,11 +844,12 @@ USA.
 	(cond ((char? key)
 	       (vector-set! table (char->integer key) handler))
 	      ((char-set? key)
-	       (for-each (lambda (char)
-			   (let ((i (char->integer char)))
-			     (if (eq? (vector-ref table i) else-action)
-				 (vector-set! table i handler))))
-			 (char-set-members key)))
+	       (char-set-for-each
+		(lambda (char)
+		  (let ((i (char->integer char)))
+		    (if (eq? (vector-ref table i) else-action)
+			(vector-set! table i handler))))
+		(char-set-intersection key char-set:ascii)))
 	      (else
 	       (error:wrong-type-argument key "char or char-set")))))
     (lambda (port emit fifo)
diff --git a/src/runtime/regexp.scm b/src/runtime/regexp.scm
index 98efe881a..2ddf6059b 100644
--- a/src/runtime/regexp.scm
+++ b/src/runtime/regexp.scm
@@ -179,7 +179,8 @@ USA.
 	(append! (cdr ranges) (list char))
 	ranges))
 
-  (let ((chars (char-set-members char-set)))
+  (let ((chars
+	 (char-set->list (char-set-intersection char-set char-set:ascii))))
     (if (pair? chars)
 	(if (pair? (cdr chars))
 	    (let ((builder (string-builder)))
diff --git a/src/runtime/rexp.scm b/src/runtime/rexp.scm
index 7df6f2e2b..0e5d892fe 100644
--- a/src/runtime/rexp.scm
+++ b/src/runtime/rexp.scm
@@ -232,15 +232,10 @@ USA.
 			  parts))))))))
 
 (define (case-fold-char-set c)
-  (let loop ((chars (char-set-members c)) (chars* '()))
-    (if (pair? chars)
-	(loop (cdr chars)
-	      (if (char-alphabetic? (car chars))
-		  (cons* (char-upcase (car chars))
-			 (char-downcase (car chars))
-			 chars*)
-		  chars*))
-	(apply char-set chars*))))
+  (let ((char-set (char-set-intersection c char-set:ascii)))
+    (char-set-union char-set
+		    (char-upcase char-set)
+		    (char-downcase char-set))))
 
 (define (rexp-n*m n m . rexps)
   (guarantee exact-nonnegative-integer? n 'rexp-n*m)