From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 11 Feb 2017 22:40:18 +0000 (-0800)
Subject: Implement unicode-char-code?.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~135
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cad5b8294e9471e6c6e168108754507cee1b1e0c;p=mit-scheme.git

Implement unicode-char-code?.
---

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 0f13d3d94..21977494d 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -375,9 +375,11 @@ USA.
 
 (define (unicode-char? object)
   (and (char? object)
-       (let ((n (char->integer object)))
-	 (and (unicode-scalar-value? n)
-	      (not (non-character? n))))))
+       (unicode-char-code? (char->integer object))))
+
+(define (unicode-char-code? object)
+  (and (unicode-scalar-value? object)
+       (not (non-character? object))))
 
 (define-integrable (unicode-code-point? object)
   (and (index-fixnum? object)
diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index 06082e347..89070c697 100644
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -316,6 +316,8 @@ USA.
 			'<= index-fixnum?)
    (register-predicate! unicode-scalar-value? 'unicode-scalar-value
 			'<= unicode-code-point?)
+   (register-predicate! unicode-char-code? 'unicode-char-code
+			'<= unicode-scalar-value?)
    (register-predicate! uninterned-symbol? 'uninterned-symbol '<= symbol?)
    (register-predicate! weak-list? 'weak-list)
    (register-predicate! weak-pair? 'weak-pair)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index eb5d8af92..939011029 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1395,6 +1395,7 @@ USA.
 	  radix?
 	  set-char-bits
 	  unicode-char->scalar-value
+	  unicode-char-code?
 	  unicode-char?
 	  unicode-code-point-general-category
 	  unicode-code-point?