From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 7 Jan 2019 00:19:59 +0000 (-0800)
Subject: Change most places that use bitless-char? to just throw away the bucket bits.
X-Git-Tag: mit-scheme-pucked-10.1.9~3^2~16
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=27c7ad98adcb0a0e0f726746dd6f9233debc3e34;p=mit-scheme.git

Change most places that use bitless-char? to just throw away the bucket bits.
---

diff --git a/src/runtime/char-set.scm b/src/runtime/char-set.scm
index 63645b194..3a4dba94d 100644
--- a/src/runtime/char-set.scm
+++ b/src/runtime/char-set.scm
@@ -52,10 +52,9 @@ USA.
 	  (delay
 	    (let ((predicate
 		   (lambda (char)
-		     (and (bitless-char? char)
+		     (and (char? char)
 			  (char-in-set? char char-set)))))
-	      (register-predicate! predicate 'char-set-predicate
-				   '<= bitless-char?)
+	      (register-predicate! predicate 'char-set-predicate '<= char?)
 	      predicate)))))
     char-set))
 
@@ -303,7 +302,7 @@ USA.
 
 (define (%cpl-element->ranges elt)
   (cond ((%range? elt) (list elt))
-	((bitless-char? elt) (list (char->integer elt)))
+	((char? elt) (list (char-code elt)))
 	((string? elt) (map char->integer (string->list elt)))
 	(else #f)))
 
@@ -355,7 +354,7 @@ USA.
 
 (define (cpl-element? object)
   (or (%range? object)
-      (bitless-char? object)
+      (char? object)
       (string? object)
       (char-set? object)
       (name->char-set object)))
@@ -416,8 +415,7 @@ USA.
 
 (define (char-in-set? char char-set)
   (guarantee char? char 'char-in-set?)
-  (and (bitless-char? char)
-       (%code-point-in-char-set? (char->integer char) char-set)))
+  (%code-point-in-char-set? (char-code char) char-set))
 
 (define (code-point-in-char-set? cp char-set)
   (guarantee unicode-code-point? cp 'code-point-in-char-set?)
diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index b29535a75..607221583 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -384,8 +384,8 @@ USA.
     n))
 
 (define (char-general-category char)
-  (guarantee bitless-char? char 'char-general-category)
-  (ucd-gc-value char))
+  (guarantee char? char 'char-general-category)
+  (code-point-general-category (char-code char)))
 
 (define (code-point-general-category cp)
   (guarantee unicode-code-point? cp 'code-point-general-category)