From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 9 Dec 2018 02:26:45 +0000 (-0800)
Subject: Implement char->bitless-char.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~10
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=001be491b18c9707b4214ee5ba13c916666b486c;p=mit-scheme.git

Implement char->bitless-char.
---

diff --git a/doc/ref-manual/characters.texi b/doc/ref-manual/characters.texi
index afa461e4a..3deff38ef 100644
--- a/doc/ref-manual/characters.texi
+++ b/doc/ref-manual/characters.texi
@@ -399,6 +399,11 @@ Returns @code{#t} if @var{object} is a character with no bucky bits
 set, otherwise it returns @code{#f} .
 @end deffn
 
+@deffn procedure char->bitless-char char
+Returns @var{char} with any bucky bits removed.  The result is
+guaranteed to satisfy @code{bitless-char?}.
+@end deffn
+
 @deffn procedure char-predicate char
 Returns a procedure of one argument that returns @code{#t} if its
 argument is a character @code{char=?} to @var{char}, otherwise it
diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index cbf8fdbbf..c3df7bc7d 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -47,16 +47,19 @@ USA.
 (define-integrable (%make-char code bits)
   (integer->char (fix:or (fix:lsh bits 21) code)))
 
-(define (char-code char)
+(define-integrable (char-code char)
   (fix:and (char->integer char) #x1FFFFF))
 
-(define (char-bits char)
+(define-integrable (char-bits char)
   (fix:lsh (char->integer char) -21))
 
 (define (bitless-char? object)
   (and (char? object)
        (fix:< (char->integer object) char-code-limit)))
 
+(define (char->bitless-char char)
+  (integer->char (char-code char)))
+
 (define (char-bits-set? bits char)
   (guarantee-limited-index-fixnum bits char-bits-limit 'char-bits-set?)
   (fix:= bits (fix:and (char-bits char) bits)))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index be6daba25..40d3f9174 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1304,6 +1304,7 @@ USA.
 	  ascii-char?
 	  bitless-char?
 	  char-8-bit?
+	  char->bitless-char
 	  char->digit
 	  char->integer
 	  char->name