From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 25 Sep 2001 05:17:00 +0000 (+0000)
Subject: Split off unchecked character comparisons, for inclusion in
X-Git-Tag: 20090517-FFI~2556
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0b92a3471b4d7e9074b27011898ad1f2e53a2c16;p=mit-scheme.git

Split off unchecked character comparisons, for inclusion in
"string.scm".
---

diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm
index 0ee70d8a6..6bb4f9fd6 100644
--- a/v7/src/runtime/char.scm
+++ b/v7/src/runtime/char.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: char.scm,v 14.12 2001/09/24 05:24:55 cph Exp $
+$Id: char.scm,v 14.13 2001/09/25 05:17:00 cph Exp $
 
 Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
 
@@ -93,6 +93,7 @@ USA.
   (map char->ascii chars))
 
 (define (char=? x y)
+  ;; There's no %CHAR=? because the compiler recodes CHAR=? as EQ?.
   (guarantee-char x 'CHAR=?)
   (guarantee-char y 'CHAR=?)
   (fix:= (char->integer x) (char->integer y)))
@@ -100,25 +101,34 @@ USA.
 (define (char<? x y)
   (guarantee-char x 'CHAR<?)
   (guarantee-char y 'CHAR<?)
+  (%char<? x y))
+
+(define-integrable (%char<? x y)
   (fix:< (char->integer x) (char->integer y)))
 
 (define (char<=? x y)
   (guarantee-char x 'CHAR<=?)
   (guarantee-char y 'CHAR<=?)
+  (%char<=? x y))
+
+(define-integrable (%char<=? x y)
   (fix:<= (char->integer x) (char->integer y)))
 
 (define (char>? x y)
   (guarantee-char x 'CHAR>?)
   (guarantee-char y 'CHAR>?)
+  (%char>? x y))
+
+(define-integrable (%char>? x y)
   (fix:> (char->integer x) (char->integer y)))
 
 (define (char>=? x y)
   (guarantee-char x 'CHAR>=?)
   (guarantee-char y 'CHAR>=?)
-  (fix:>= (char->integer x) (char->integer y)))
+  (%char>=? x y))
 
-(define (char-ci->integer char)
-  (char->integer (char-upcase char)))
+(define-integrable (%char>=? x y)
+  (fix:>= (char->integer x) (char->integer y)))
 
 (define (char-ci=? x y)
   (fix:= (char-ci->integer x) (char-ci->integer y)))
@@ -134,6 +144,9 @@ USA.
 
 (define (char-ci>=? x y)
   (fix:>= (char-ci->integer x) (char-ci->integer y)))
+
+(define-integrable (char-ci->integer char)
+  (char->integer (char-upcase char)))
 
 (define (char-downcase char)
   (guarantee-char char 'CHAR-DOWNCASE)
@@ -141,26 +154,20 @@ USA.
 
 (define (%char-downcase char)
   (if (fix:< (%char-code char) 256)
-      (%%char-downcase char)
+      (%make-char (vector-8b-ref downcase-table (%char-code char))
+		  (%char-bits char))
       char))
 
-(define-integrable (%%char-downcase char)
-  (%make-char (vector-8b-ref downcase-table (%char-code char))
-	      (%char-bits char)))
-
 (define (char-upcase char)
   (guarantee-char char 'CHAR-UPCASE)
   (%char-upcase char))
 
 (define (%char-upcase char)
   (if (fix:< (%char-code char) 256)
-      (%%char-upcase char)
+      (%make-char (vector-8b-ref upcase-table (%char-code char))
+		  (%char-bits char))
       char))
 
-(define-integrable (%%char-upcase char)
-  (%make-char (vector-8b-ref upcase-table (%char-code char))
-	      (%char-bits char)))
-
 (define downcase-table)
 (define upcase-table)