From f6a3f20e3a49bcfaefc12996ba6d1dadbace1828 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 4 Dec 2019 22:19:52 -0800 Subject: [PATCH] Eliminate use of char-set-members. --- src/edwin/comtab.scm | 2 +- src/edwin/paredit.scm | 2 +- src/runtime/chrsyn.scm | 7 ++++--- src/runtime/http-syntax.scm | 11 ++++++----- src/runtime/regexp.scm | 3 ++- src/runtime/rexp.scm | 13 ++++--------- 6 files changed, 18 insertions(+), 20 deletions(-) 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) -- 2.25.1